Theory UML_Types
chapter‹Formalization I: OCL Types and Core Definitions \label{sec:focl-types}›
theory UML_Types
imports HOL.Transcendental
keywords "Assert" :: thy_decl
and "Assert_local" :: thy_decl
begin
section‹Preliminaries›
subsection‹Notations for the Option Type›
text‹
First of all, we will use a more compact notation for the library
option type which occur all over in our definitions and which will make
the presentation more like a textbook:
›
no_notation ceiling ("⌈_⌉")
no_notation floor ("⌊_⌋")
type_notation option ("⟨_⟩⇩⊥")
notation Some ("⌊(_)⌋")
notation None ("⊥")
text‹These commands introduce an alternative, more compact notation for the type constructor
@{typ "'α option"}, namely @{typ "⟨'α⟩⇩⊥"}. Furthermore, the constructors @{term "Some X"} and
@{term "None"} of the type @{typ "'α option"}, namely @{term "⌊X⌋"} and @{term "⊥"}.›
text‹
The following function (corresponding to @{term the} in the Isabelle/HOL library)
is defined as the inverse of the injection @{term Some}.
›
fun drop :: "'α option ⇒ 'α" ("⌈(_)⌉")
where drop_lift[simp]: "⌈⌊v⌋⌉ = v"
text‹The definitions for the constants and operations based on functions
will be geared towards a format that Isabelle can check to be a ``conservative''
(\ie, logically safe) axiomatic definition. By introducing an explicit
interpretation function (which happens to be defined just as the identity
since we are using a shallow embedding of OCL into HOL), all these definitions
can be rewritten into the conventional semantic textbook format.
To say it in other words: The interpretation function ‹Sem› as defined
below is just a textual marker for presentation purposes, i.e. intended for readers
used to conventional textbook notations on semantics. Since we use a ``shallow embedding'',
i.e. since we represent the syntax of OCL directly by HOL constants, the interpretation function
is semantically not only superfluous, but from an Isabelle perspective strictly in
the way for certain consistency checks performed by the definitional packages.
›
definition Sem :: "'a ⇒ 'a" ("I⟦_⟧")
where "I⟦x⟧ ≡ x"
subsection‹Common Infrastructure for all OCL Types \label{sec:focl-common-types}›
text ‹In order to have the possibility to nest collection types,
such that we can give semantics to expressions like ‹Set{Set{𝟮},null}›,
it is necessary to introduce a uniform interface for types having
the ‹invalid› (= bottom) element. The reason is that we impose
a data-invariant on raw-collection \inlineisar|types_code| which assures
that the ‹invalid› element is not allowed inside the collection;
all raw-collections of this form were identified with the ‹invalid› element
itself. The construction requires that the new collection type is
not comparable with the raw-types (consisting of nested option type constructions),
such that the data-invariant must be expressed in terms of the interface.
In a second step, our base-types will be shown to be instances of this interface.
›
text‹
This uniform interface consists in a type class requiring the existence
of a bot and a null element. The construction proceeds by
abstracting the null (defined by ‹⌊ ⊥ ⌋› on
‹'a option option›) to a ‹null› element, which may
have an arbitrary semantic structure, and an undefinedness element ‹⊥›
to an abstract undefinedness element ‹bot› (also written
‹⊥› whenever no confusion arises). As a consequence, it is necessary
to redefine the notions of invalid, defined, valuation etc.
on top of this interface.›
text‹
This interface consists in two abstract type classes ‹bot›
and ‹null› for the class of all types comprising a bot and a
distinct null element.›
class bot =
fixes bot :: "'a"
assumes nonEmpty : "∃ x. x ≠ bot"
class null = bot +
fixes null :: "'a"
assumes null_is_valid : "null ≠ bot"
subsection‹Accommodation of Basic Types to the Abstract Interface›
text‹
In the following it is shown that the ``option-option'' type is
in fact in the ‹null› class and that function spaces over these
classes again ``live'' in these classes. This motivates the default construction
of the semantic domain for the basic types (\inlineocl{Boolean},
\inlineocl{Integer}, \inlineocl{Real}, \ldots).
›
instantiation option :: (type)bot
begin
definition bot_option_def: "(bot::'a option) ≡ (None::'a option)"
instance proof show "∃x::'a option. x ≠ bot"
by(rule_tac x="Some x" in exI, simp add:bot_option_def)
qed
end
instantiation option :: (bot)null
begin
definition null_option_def: "(null::'a::bot option) ≡ ⌊ bot ⌋"
instance proof show "(null::'a::bot option) ≠ bot"
by( simp add : null_option_def bot_option_def)
qed
end
instantiation "fun" :: (type,bot) bot
begin
definition bot_fun_def: "bot ≡ (λ x. bot)"
instance proof show "∃(x::'a ⇒ 'b). x ≠ bot"
apply(rule_tac x="λ _. (SOME y. y ≠ bot)" in exI, auto)
apply(drule_tac x=x in fun_cong,auto simp:bot_fun_def)
apply(erule contrapos_pp, simp)
apply(rule some_eq_ex[THEN iffD2])
apply(simp add: nonEmpty)
done
qed
end
instantiation "fun" :: (type,null) null
begin
definition null_fun_def: "(null::'a ⇒ 'b::null) ≡ (λ x. null)"
instance proof
show "(null::'a ⇒ 'b::null) ≠ bot"
apply(auto simp: null_fun_def bot_fun_def)
apply(drule_tac x=x in fun_cong)
apply(erule contrapos_pp, simp add: null_is_valid)
done
qed
end
text‹A trivial consequence of this adaption of the interface is that
abstract and concrete versions of null are the same on base types
(as could be expected).›
subsection‹The Common Infrastructure of Object Types (Class Types) and States.›
text‹Recall that OCL is a textual extension of the UML; in particular, we use OCL as means to
annotate UML class models. Thus, OCL inherits a notion of \emph{data} in the UML: UML class
models provide classes, inheritance, types of objects, and subtypes connecting them along
the inheritance hierarchie.
›
text‹For the moment, we formalize the most common notions of objects, in particular
the existance of object-identifiers (oid) for each object under which it can
be referenced in a \emph{state}.›
type_synonym oid = nat
text‹We refrained from the alternative:
\begin{isar}[mathescape]
$\text{\textbf{type-synonym}}$ $\mathit{oid = ind}$
\end{isar}
which is slightly more abstract but non-executable.
›
text‹\emph{States} in UML/OCL are a pair of
\begin{itemize}
\item a partial map from oid's to elements of an \emph{object universe},
\ie{} the set of all possible object representations.
\item and an oid-indexed family of \emph{associations}, \ie{} finite relations between
objects living in a state. These relations can be n-ary which we model by nested lists.
\end{itemize}
For the moment we do not have to describe the concrete structure of the object universe and denote
it by the polymorphic variable ‹'𝔄›.›
record ('𝔄)state =
heap :: "oid ⇀ '𝔄 "
assocs :: "oid ⇀ ((oid list) list) list"
text‹In general, OCL operations are functions implicitly depending on a pair
of pre- and post-state, \ie{} \emph{state transitions}. Since this will be reflected in our
representation of OCL Types within HOL, we need to introduce the foundational concept of an
object id (oid), which is just some infinite set, and some abstract notion of state.›
type_synonym ('𝔄)st = "'𝔄 state × '𝔄 state"
text‹We will require for all objects that there is a function that
projects the oid of an object in the state (we will settle the question how to define
this function later). We will use the Isabelle type class mechanism~\cite{haftmann.ea:constructive:2006}
to capture this:›
class object = fixes oid_of :: "'a ⇒ oid"
text‹Thus, if needed, we can constrain the object universe to objects by adding
the following type class constraint:›
typ "'𝔄 :: object"
text‹The major instance needed are instances constructed over options: once an object,
options of objects are also objects.›
instantiation option :: (object)object
begin
definition oid_of_option_def: "oid_of x = oid_of (the x)"
instance ..
end
subsection‹Common Infrastructure for all OCL Types (II): Valuations as OCL Types›
text‹Since OCL operations in general depend on pre- and post-states, we will
represent OCL types as \emph{functions} from pre- and post-state to some
HOL raw-type that contains exactly the data in the OCL type --- see below.
This gives rise to the idea that we represent OCL types by \emph{Valuations}.
›
text‹Valuations are functions from a state pair (built upon
data universe @{typ "'𝔄"}) to an arbitrary null-type (\ie, containing
at least a destinguished ‹null› and ‹invalid› element).›
type_synonym ('𝔄,'α) val = "'𝔄 st ⇒ 'α::null"
text‹The definitions for the constants and operations based on valuations
will be geared towards a format that Isabelle can check to be a ``conservative''
(\ie, logically safe) axiomatic definition. By introducing an explicit
interpretation function (which happens to be defined just as the identity
since we are using a shallow embedding of OCL into HOL), all these definitions
can be rewritten into the conventional semantic textbook format as follows:›
subsection‹The fundamental constants 'invalid' and 'null' in all OCL Types›
text‹As a consequence of semantic domain definition, any OCL type will
have the two semantic constants ‹invalid› (for exceptional, aborted
computation) and ‹null›:
›
definition invalid :: "('𝔄,'α::bot) val"
where "invalid ≡ λ τ. bot"
text‹This conservative Isabelle definition of the polymorphic constant
@{const invalid} is equivalent with the textbook definition:›
lemma textbook_invalid: "I⟦invalid⟧τ = bot"
by(simp add: invalid_def Sem_def)
text ‹Note that the definition :
{\small
\begin{isar}[mathescape]
definition null :: "('$\mathfrak{A}$,'α::null) val"
where "null ≡ λ τ. null"
\end{isar}
} is not necessary since we defined the entire function space over null types
again as null-types; the crucial definition is @{thm "null_fun_def"}.
Thus, the polymorphic constant @{const null} is simply the result of
a general type class construction. Nevertheless, we can derive the
semantic textbook definition for the OCL null constant based on the
abstract null:
›
lemma textbook_null_fun: "I⟦null::('𝔄,'α::null) val⟧ τ = (null::('α::null))"
by(simp add: null_fun_def Sem_def)
section‹Basic OCL Value Types›
text ‹The structure of this section roughly follows the structure of Chapter
11 of the OCL standard~\cite{omg:ocl:2012}, which introduces the OCL
Library.›
text‹The semantic domain of the (basic) boolean type is now defined as the Standard:
the space of valuation to @{typ "bool option option"}, \ie{} the Boolean base type:›
type_synonym Boolean⇩b⇩a⇩s⇩e = "bool option option"
type_synonym ('𝔄)Boolean = "('𝔄,Boolean⇩b⇩a⇩s⇩e) val"
text‹Because of the previous class definitions, Isabelle type-inference establishes that
@{typ "('𝔄)Boolean"} lives actually both in the type class @{term bot} and @{term null};
this type is sufficiently rich to contain at least these two elements.
Analogously we build:›
type_synonym Integer⇩b⇩a⇩s⇩e = "int option option"
type_synonym ('𝔄)Integer = "('𝔄,Integer⇩b⇩a⇩s⇩e) val"
type_synonym String⇩b⇩a⇩s⇩e = "string option option"
type_synonym ('𝔄)String = "('𝔄,String⇩b⇩a⇩s⇩e) val"
type_synonym Real⇩b⇩a⇩s⇩e = "real option option"
type_synonym ('𝔄)Real = "('𝔄,Real⇩b⇩a⇩s⇩e) val"
text‹Since @{term "Real"} is again a basic type, we define its semantic domain
as the valuations over ‹real option option› --- i.e. the mathematical type of real numbers.
The HOL-theory for ‹real› ``Real'' transcendental numbers such as $\pi$ and $e$ as well as
infrastructure to reason over infinite convergent Cauchy-sequences (it is thus possible, in principle,
to reason in Featherweight OCL that the sum of inverted two-s exponentials is actually 2.
If needed, a code-generator to compile ‹Real› to floating-point
numbers can be added; this allows for mapping reals to an efficient machine representation;
of course, this feature would be logically unsafe.›
text‹For technical reasons related to the Isabelle type inference for type-classes
(we don't get the properties in the right order that class instantiation provides them,
if we would follow the previous scheme), we give a slightly atypic definition:›
typedef Void⇩b⇩a⇩s⇩e = "{X::unit option option. X = bot ∨ X = null }" by(rule_tac x="bot" in exI, simp)
type_synonym ('𝔄)Void = "('𝔄,Void⇩b⇩a⇩s⇩e) val"
section‹Some OCL Collection Types›
text‹For the semantic construction of the collection types, we have two goals:
\begin{enumerate}
\item we want the types to be \emph{fully abstract}, \ie, the type should not
contain junk-elements that are not representable by OCL expressions, and
\item we want a possibility to nest collection types (so, we want the
potential of talking about ‹Set(Set(Sequences(Pairs(X,Y))))›).
\end{enumerate}
The former principle rules out the option to define ‹'α Set› just by
‹('𝔄, ('α option option) set) val›. This would allow sets to contain
junk elements such as ‹{⊥}› which we need to identify with undefinedness
itself. Abandoning fully abstractness of rules would later on produce all sorts
of problems when quantifying over the elements of a type.
However, if we build an own type, then it must conform to our abstract interface
in order to have nested types: arguments of type-constructors must conform to our
abstract interface, and the result type too.
›
subsection‹The Construction of the Pair Type (Tuples)›
text‹The core of an own type construction is done via a type
definition which provides the base-type ‹('α, 'β) Pair⇩b⇩a⇩s⇩e›. It
is shown that this type ``fits'' indeed into the abstract type
interface discussed in the previous section.›
typedef (overloaded) ('α, 'β) Pair⇩b⇩a⇩s⇩e = "{X::('α::null × 'β::null) option option.
X = bot ∨ X = null ∨ (fst⌈⌈X⌉⌉ ≠ bot ∧ snd⌈⌈X⌉⌉ ≠ bot)}"
by (rule_tac x="bot" in exI, simp)
text‹We ``carve'' out from the concrete type @{typ "('α::null × 'β::null) option option"}
the new fully abstract type, which will not contain representations like @{term "⌊⌊(⊥,a)⌋⌋"}
or @{term "⌊⌊(b,⊥)⌋⌋"}. The type constuctor ‹Pair{x,y}› to be defined later will
identify these with @{term "invalid"}.
›
instantiation Pair⇩b⇩a⇩s⇩e :: (null,null)bot
begin
definition bot_Pair⇩b⇩a⇩s⇩e_def: "(bot_class.bot :: ('a::null,'b::null) Pair⇩b⇩a⇩s⇩e) ≡ Abs_Pair⇩b⇩a⇩s⇩e None"
instance proof show "∃x::('a,'b) Pair⇩b⇩a⇩s⇩e. x ≠ bot"
apply(rule_tac x="Abs_Pair⇩b⇩a⇩s⇩e ⌊None⌋" in exI)
by(simp add: bot_Pair⇩b⇩a⇩s⇩e_def Abs_Pair⇩b⇩a⇩s⇩e_inject null_option_def bot_option_def)
qed
end
instantiation Pair⇩b⇩a⇩s⇩e :: (null,null)null
begin
definition null_Pair⇩b⇩a⇩s⇩e_def: "(null::('a::null,'b::null) Pair⇩b⇩a⇩s⇩e) ≡ Abs_Pair⇩b⇩a⇩s⇩e ⌊ None ⌋"
instance proof show "(null::('a::null,'b::null) Pair⇩b⇩a⇩s⇩e) ≠ bot"
by(simp add: bot_Pair⇩b⇩a⇩s⇩e_def null_Pair⇩b⇩a⇩s⇩e_def Abs_Pair⇩b⇩a⇩s⇩e_inject
null_option_def bot_option_def)
qed
end
text‹... and lifting this type to the format of a valuation gives us:›
type_synonym ('𝔄,'α,'β) Pair = "('𝔄, ('α,'β) Pair⇩b⇩a⇩s⇩e) val"
type_notation Pair⇩b⇩a⇩s⇩e ("Pair'(_,_')")
subsection‹The Construction of the Set Type›
text‹The core of an own type construction is done via a type
definition which provides the raw-type ‹'α Set⇩b⇩a⇩s⇩e›. It
is shown that this type ``fits'' indeed into the abstract type
interface discussed in the previous section. Note that we make
no restriction whatsoever to \emph{finite} sets; while with
the standards type-constructors only finite sets can be denoted,
there is the possibility to define in fact infinite
type constructors in \FOCL (c.f. \autoref{sec:type-extensions}).›
typedef (overloaded) 'α Set⇩b⇩a⇩s⇩e ="{X::('α::null) set option option. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by (rule_tac x="bot" in exI, simp)
instantiation Set⇩b⇩a⇩s⇩e :: (null)bot
begin
definition bot_Set⇩b⇩a⇩s⇩e_def: "(bot::('a::null) Set⇩b⇩a⇩s⇩e) ≡ Abs_Set⇩b⇩a⇩s⇩e None"
instance proof show "∃x::'a Set⇩b⇩a⇩s⇩e. x ≠ bot"
apply(rule_tac x="Abs_Set⇩b⇩a⇩s⇩e ⌊None⌋" in exI)
by(simp add: bot_Set⇩b⇩a⇩s⇩e_def Abs_Set⇩b⇩a⇩s⇩e_inject null_option_def bot_option_def)
qed
end
instantiation Set⇩b⇩a⇩s⇩e :: (null)null
begin
definition null_Set⇩b⇩a⇩s⇩e_def: "(null::('a::null) Set⇩b⇩a⇩s⇩e) ≡ Abs_Set⇩b⇩a⇩s⇩e ⌊ None ⌋"
instance proof show "(null::('a::null) Set⇩b⇩a⇩s⇩e) ≠ bot"
by(simp add:null_Set⇩b⇩a⇩s⇩e_def bot_Set⇩b⇩a⇩s⇩e_def Abs_Set⇩b⇩a⇩s⇩e_inject
null_option_def bot_option_def)
qed
end
text‹... and lifting this type to the format of a valuation gives us:›
type_synonym ('𝔄,'α) Set = "('𝔄, 'α Set⇩b⇩a⇩s⇩e) val"
type_notation Set⇩b⇩a⇩s⇩e ("Set'(_')")
subsection‹The Construction of the Bag Type›
text‹The core of an own type construction is done via a type
definition which provides the raw-type ‹'α Bag⇩b⇩a⇩s⇩e›
based on multi-sets from the \HOL library. As in Sets, it
is shown that this type ``fits'' indeed into the abstract type
interface discussed in the previous section, and as in sets, we make
no restriction whatsoever to \emph{finite} multi-sets; while with
the standards type-constructors only finite sets can be denoted,
there is the possibility to define in fact infinite
type constructors in \FOCL (c.f. \autoref{sec:type-extensions}).
However, while several ‹null› elements are possible in a Bag, there
can't be no bottom (invalid) element in them.
›
typedef (overloaded) 'α Bag⇩b⇩a⇩s⇩e ="{X::('α::null ⇒ nat) option option. X = bot ∨ X = null ∨ ⌈⌈X⌉⌉ bot = 0 }"
by (rule_tac x="bot" in exI, simp)
instantiation Bag⇩b⇩a⇩s⇩e :: (null)bot
begin
definition bot_Bag⇩b⇩a⇩s⇩e_def: "(bot::('a::null) Bag⇩b⇩a⇩s⇩e) ≡ Abs_Bag⇩b⇩a⇩s⇩e None"
instance proof show "∃x::'a Bag⇩b⇩a⇩s⇩e. x ≠ bot"
apply(rule_tac x="Abs_Bag⇩b⇩a⇩s⇩e ⌊None⌋" in exI)
by(simp add: bot_Bag⇩b⇩a⇩s⇩e_def Abs_Bag⇩b⇩a⇩s⇩e_inject
null_option_def bot_option_def)
qed
end
instantiation Bag⇩b⇩a⇩s⇩e :: (null)null
begin
definition null_Bag⇩b⇩a⇩s⇩e_def: "(null::('a::null) Bag⇩b⇩a⇩s⇩e) ≡ Abs_Bag⇩b⇩a⇩s⇩e ⌊ None ⌋"
instance proof show "(null::('a::null) Bag⇩b⇩a⇩s⇩e) ≠ bot"
by(simp add:null_Bag⇩b⇩a⇩s⇩e_def bot_Bag⇩b⇩a⇩s⇩e_def Abs_Bag⇩b⇩a⇩s⇩e_inject
null_option_def bot_option_def)
qed
end
text‹... and lifting this type to the format of a valuation gives us:›
type_synonym ('𝔄,'α) Bag = "('𝔄, 'α Bag⇩b⇩a⇩s⇩e) val"
type_notation Bag⇩b⇩a⇩s⇩e ("Bag'(_')")
subsection‹The Construction of the Sequence Type›
text‹The core of an own type construction is done via a type
definition which provides the base-type ‹'α Sequence⇩b⇩a⇩s⇩e›. It
is shown that this type ``fits'' indeed into the abstract type
interface discussed in the previous section.›
typedef (overloaded) 'α Sequence⇩b⇩a⇩s⇩e ="{X::('α::null) list option option.
X = bot ∨ X = null ∨ (∀x∈set ⌈⌈X⌉⌉. x ≠ bot)}"
by (rule_tac x="bot" in exI, simp)
instantiation Sequence⇩b⇩a⇩s⇩e :: (null)bot
begin
definition bot_Sequence⇩b⇩a⇩s⇩e_def: "(bot::('a::null) Sequence⇩b⇩a⇩s⇩e) ≡ Abs_Sequence⇩b⇩a⇩s⇩e None"
instance proof show "∃x::'a Sequence⇩b⇩a⇩s⇩e. x ≠ bot"
apply(rule_tac x="Abs_Sequence⇩b⇩a⇩s⇩e ⌊None⌋" in exI)
by(auto simp:bot_Sequence⇩b⇩a⇩s⇩e_def Abs_Sequence⇩b⇩a⇩s⇩e_inject
null_option_def bot_option_def)
qed
end
instantiation Sequence⇩b⇩a⇩s⇩e :: (null)null
begin
definition null_Sequence⇩b⇩a⇩s⇩e_def: "(null::('a::null) Sequence⇩b⇩a⇩s⇩e) ≡ Abs_Sequence⇩b⇩a⇩s⇩e ⌊ None ⌋"
instance proof show "(null::('a::null) Sequence⇩b⇩a⇩s⇩e) ≠ bot"
by(auto simp:bot_Sequence⇩b⇩a⇩s⇩e_def null_Sequence⇩b⇩a⇩s⇩e_def Abs_Sequence⇩b⇩a⇩s⇩e_inject
null_option_def bot_option_def)
qed
end
text‹... and lifting this type to the format of a valuation gives us:›
type_synonym ('𝔄,'α) Sequence = "('𝔄, 'α Sequence⇩b⇩a⇩s⇩e) val"
type_notation Sequence⇩b⇩a⇩s⇩e ("Sequence'(_')")
subsection‹Discussion: The Representation of UML/OCL Types in Featherweight OCL›
text‹In the introduction, we mentioned that there is an ``injective representation
mapping'' between the types of OCL and the types of Featherweight OCL (and its
meta-language: HOL). This injectivity is at the heart of our representation technique
--- a so-called \emph{shallow embedding} --- and means: OCL types were mapped one-to-one
to types in HOL, ruling out a resentation where
everything is mapped on some common HOL-type, say ``OCL-expression'', in which we
would have to sort out the typing of OCL and its impact on the semantic representation
function in an own, quite heavy side-calculus.
›
text‹After the previous sections, we are now able to exemplify this representation as follows:
\begin{table}[htbp]
\centering
\begin{tabu}{lX[,c,]}
\toprule
OCL Type & HOL Type \\
\midrule
\inlineocl|Boolean| & @{typ "('𝔄)Boolean"} \\
\inlineocl|Boolean -> Boolean| & @{typ "('𝔄)Boolean ⇒ ('𝔄)Boolean"} \\
\inlineocl|(Integer,Integer) -> Boolean| & @{typ "('𝔄)Integer ⇒ ('𝔄)Integer ⇒ ('𝔄)Boolean"} \\
\inlineocl|Set(Integer)| & @{typ "('𝔄,Integer⇩b⇩a⇩s⇩e)Set"} \\
\inlineocl|Set(Integer)-> Real| & @{typ "('𝔄,Integer⇩b⇩a⇩s⇩e)Set ⇒ ('𝔄)Real"} \\
\inlineocl|Set(Pair(Integer,Boolean))| & @{typ "('𝔄,(Integer⇩b⇩a⇩s⇩e, Boolean⇩b⇩a⇩s⇩e)Pair⇩b⇩a⇩s⇩e)Set"} \\
\inlineocl|Set(<T>)| & @{typ "('𝔄,'α::null)Set"} \\
\bottomrule
\end{tabu}
\caption{Correspondance between \OCL types and \HOL types}
\label{tab:types}
\end{table}
We do not formalize the representation map here; however, its principles are quite straight-forward:
\begin{enumerate}
\item cartesion products of arguments were curried,
\item constants of type \inlineocl{T} were mapped to valuations over the
HOL-type for \inlineocl{T},
\item functions \inlineocl{T -> T'} were mapped to functions in HOL, where
\inlineocl{T} and \inlineocl{T'} were mapped to the valuations for them, and
\item the arguments of type constructors \inlineocl{Set(T)} remain corresponding HOL base-types.
\end{enumerate}
›
text‹Note, furthermore, that our construction of ``fully abstract types'' (no junk, no confusion)
assures that the logical equality to be defined in the next section works correctly and comes
as element of the ``lingua franca'', \ie{} HOL.›
section‹Miscelleaneous: ML assertions›
text‹We introduce here a new command \emph{Assert} similar as \emph{value} for proving
that the given term in argument is a true proposition. The difference with \emph{value} is that
\emph{Assert} fails if the normal form of the term evaluated is not equal to @{term True}.
Moreover, in case \emph{value} could not normalize the given term, as another strategy of reduction
we try to prove it with a single ``simp'' tactic.›
ML‹
fun disp_msg title msg status = title ^ ": '" ^ msg ^ "' " ^ status
fun lemma msg specification_theorem concl in_local thy =
SOME
(in_local (fn lthy =>
specification_theorem Thm.theoremK NONE (K I) Binding.empty_atts [] []
(Element.Shows [(Binding.empty_atts, [(concl lthy, [])])])
false lthy
|> Proof.global_terminal_proof
((Method.Combinator ( Method.no_combinator_info
, Method.Then
, [Method.Basic (fn ctxt => SIMPLE_METHOD (asm_full_simp_tac ctxt 1))]),
(Position.none, Position.none)), NONE))
thy)
handle ERROR s =>
(warning s; writeln (disp_msg "KO" msg "failed to normalize"); NONE)
fun outer_syntax_command command_spec theory in_local =
Outer_Syntax.command command_spec "assert that the given specification is true"
(Parse.term >> (fn elems_concl => theory (fn thy =>
case
lemma "nbe" (Specification.theorem true)
(fn lthy =>
let val expr = Nbe.dynamic_value lthy (Syntax.read_term lthy elems_concl)
val thy = Proof_Context.theory_of lthy
open HOLogic in
if Sign.typ_equiv thy (fastype_of expr, @{typ "prop"}) then
expr
else mk_Trueprop (mk_eq (@{term "True"}, expr))
end)
in_local
thy
of NONE =>
let val attr_simp = "simp" in
case lemma attr_simp (Specification.theorem_cmd true) (K elems_concl) in_local thy of
NONE => raise (ERROR "Assertion failed")
| SOME thy =>
(writeln (disp_msg "OK" "simp" "finished the normalization");
thy)
end
| SOME thy => thy)))
val () = outer_syntax_command @{command_keyword Assert} Toplevel.theory Named_Target.theory_map
val () = outer_syntax_command @{command_keyword Assert_local} (Toplevel.local_theory NONE NONE) I
›
end
Theory UML_Logic
chapter‹Formalization II: OCL Terms and Library Operations›
theory UML_Logic
imports UML_Types
begin
section‹The Operations of the Boolean Type and the OCL Logic›
subsection‹Basic Constants›
lemma bot_Boolean_def : "(bot::('𝔄)Boolean) = (λ τ. ⊥)"
by(simp add: bot_fun_def bot_option_def)
lemma null_Boolean_def : "(null::('𝔄)Boolean) = (λ τ. ⌊⊥⌋)"
by(simp add: null_fun_def null_option_def bot_option_def)
definition true :: "('𝔄)Boolean"
where "true ≡ λ τ. ⌊⌊True⌋⌋"
definition false :: "('𝔄)Boolean"
where "false ≡ λ τ. ⌊⌊False⌋⌋"
lemma bool_split_0: "X τ = invalid τ ∨ X τ = null τ ∨
X τ = true τ ∨ X τ = false τ"
apply(simp add: invalid_def null_def true_def false_def)
apply(case_tac "X τ",simp_all add: null_fun_def null_option_def bot_option_def)
apply(case_tac "a",simp)
apply(case_tac "aa",simp)
apply auto
done
lemma [simp]: "false (a, b) = ⌊⌊False⌋⌋"
by(simp add:false_def)
lemma [simp]: "true (a, b) = ⌊⌊True⌋⌋"
by(simp add:true_def)
lemma textbook_true: "I⟦true⟧ τ = ⌊⌊True⌋⌋"
by(simp add: Sem_def true_def)
lemma textbook_false: "I⟦false⟧ τ = ⌊⌊False⌋⌋"
by(simp add: Sem_def false_def)
text ‹
\begin{table}[htbp]
\centering
\begin{tabu}{lX[,c,]}
\toprule
Name & Theorem \\
\midrule
@{thm [source] textbook_invalid} & @{thm [display=false] textbook_invalid} \\
@{thm [source] textbook_null_fun} & @{thm [display=false] textbook_null_fun} \\
@{thm [source] textbook_true} & @{thm [display=false] textbook_true} \\
@{thm [source] textbook_false} & @{thm [display=false] textbook_false} \\
\bottomrule
\end{tabu}
\caption{Basic semantic constant definitions of the logic}
\label{tab:sem_basic_constants}
\end{table}
›
subsection‹Validity and Definedness›
text‹However, this has also the consequence that core concepts like definedness,
validity and even cp have to be redefined on this type class:›
definition valid :: "('𝔄,'a::null)val ⇒ ('𝔄)Boolean" ("υ _" [100]100)
where "υ X ≡ λ τ . if X τ = bot τ then false τ else true τ"
lemma valid1[simp]: "υ invalid = false"
by(rule ext,simp add: valid_def bot_fun_def bot_option_def
invalid_def true_def false_def)
lemma valid2[simp]: "υ null = true"
by(rule ext,simp add: valid_def bot_fun_def bot_option_def null_is_valid
null_fun_def invalid_def true_def false_def)
lemma valid3[simp]: "υ true = true"
by(rule ext,simp add: valid_def bot_fun_def bot_option_def null_is_valid
null_fun_def invalid_def true_def false_def)
lemma valid4[simp]: "υ false = true"
by(rule ext,simp add: valid_def bot_fun_def bot_option_def null_is_valid
null_fun_def invalid_def true_def false_def)
text_raw‹\isatagafp›
lemma cp_valid: "(υ X) τ = (υ (λ _. X τ)) τ"
by(simp add: valid_def)
text_raw‹\endisatagafp›
definition defined :: "('𝔄,'a::null)val ⇒ ('𝔄)Boolean" ("δ _" [100]100)
where "δ X ≡ λ τ . if X τ = bot τ ∨ X τ = null τ then false τ else true τ"
text‹The generalized definitions of invalid and definedness have the same
properties as the old ones :›
lemma defined1[simp]: "δ invalid = false"
by(rule ext,simp add: defined_def bot_fun_def bot_option_def
null_def invalid_def true_def false_def)
lemma defined2[simp]: "δ null = false"
by(rule ext,simp add: defined_def bot_fun_def bot_option_def
null_def null_option_def null_fun_def invalid_def true_def false_def)
lemma defined3[simp]: "δ true = true"
by(rule ext,simp add: defined_def bot_fun_def bot_option_def null_is_valid null_option_def
null_fun_def invalid_def true_def false_def)
lemma defined4[simp]: "δ false = true"
by(rule ext,simp add: defined_def bot_fun_def bot_option_def null_is_valid null_option_def
null_fun_def invalid_def true_def false_def)
lemma defined5[simp]: "δ δ X = true"
by(rule ext,
auto simp: defined_def true_def false_def
bot_fun_def bot_option_def null_option_def null_fun_def)
lemma defined6[simp]: "δ υ X = true"
by(rule ext,
auto simp: valid_def defined_def true_def false_def
bot_fun_def bot_option_def null_option_def null_fun_def)
lemma valid5[simp]: "υ υ X = true"
by(rule ext,
auto simp: valid_def true_def false_def
bot_fun_def bot_option_def null_option_def null_fun_def)
lemma valid6[simp]: "υ δ X = true"
by(rule ext,
auto simp: valid_def defined_def true_def false_def
bot_fun_def bot_option_def null_option_def null_fun_def)
text_raw‹\isatagafp›
lemma cp_defined:"(δ X)τ = (δ (λ _. X τ)) τ"
by(simp add: defined_def)
text_raw‹\endisatagafp›
text‹The definitions above for the constants @{const defined} and @{const valid}
can be rewritten into the conventional semantic "textbook" format as follows:›
lemma textbook_defined: "I⟦δ(X)⟧ τ = (if I⟦X⟧ τ = I⟦bot⟧ τ ∨ I⟦X⟧ τ = I⟦null⟧ τ
then I⟦false⟧ τ
else I⟦true⟧ τ)"
by(simp add: Sem_def defined_def)
lemma textbook_valid: "I⟦υ(X)⟧ τ = (if I⟦X⟧ τ = I⟦bot⟧ τ
then I⟦false⟧ τ
else I⟦true⟧ τ)"
by(simp add: Sem_def valid_def)
text ‹
\autoref{tab:sem_definedness} and \autoref{tab:alglaws_definedness}
summarize the results of this section.
\begin{table}[htbp]
\centering
\begin{tabu}{lX[,c,]}
\toprule
Name & Theorem \\
\midrule
@{thm [source] textbook_defined} & @{thm [show_question_marks=false,display=false,margin=45] textbook_defined} \\
@{thm [source] textbook_valid} & @{thm [show_question_marks=false,display=false,margin=45] textbook_valid} \\
\bottomrule
\end{tabu}
\caption{Basic predicate definitions of the logic.}
\label{tab:sem_definedness}
\end{table}
\begin{table}[htbp]
\centering
\begin{tabu}{lX[,c,]}
\toprule
Name & Theorem \\
\midrule
@{thm [source] defined1} & @{thm defined1} \\
@{thm [source] defined2} & @{thm [display=false,margin=35] defined2} \\
@{thm [source] defined3} & @{thm [display=false,margin=35] defined3} \\
@{thm [source] defined4} & @{thm [display=false,margin=35] defined4} \\
@{thm [source] defined5} & @{thm [display=false,margin=35] defined5} \\
@{thm [source] defined6} & @{thm [display=false,margin=35] defined6} \\
\bottomrule
\end{tabu}
\caption{Laws of the basic predicates of the logic.}
\label{tab:alglaws_definedness}
\end{table}
›
subsection‹The Equalities of OCL \label{sec:equality}›
text‹
The OCL contains a particular version of equality, written in
Standard documents \inlineocl+_ = _+ and \inlineocl+_ <> _+ for its
negation, which is referred as \emph{weak referential equality}
hereafter and for which we use the symbol \inlineisar+_ ≐ _+
throughout the formal part of this document. Its semantics is
motivated by the desire of fast execution, and similarity to
languages like Java and C, but does not satisfy the needs of logical
reasoning over OCL expressions and specifications. We therefore
introduce a second equality, referred as \emph{strong equality} or
\emph{logical equality} and written \inlineisar+_ ≜ _+
which is not present in the current standard but was discussed in
prior texts on OCL like the Amsterdam
Manifesto~\cite{cook.ea::amsterdam:2002} and was identified as
desirable extension of OCL in the Aachen
Meeting~\cite{brucker.ea:summary-aachen:2013} in the future 2.5 OCL
Standard. The purpose of strong equality is to define and reason
over OCL. It is therefore a natural task in Featherweight OCL to
formally investigate the somewhat quite complex relationship between
these two.› text‹Strong equality has two motivations: a
pragmatic one and a fundamental one.
\begin{enumerate}
\item The pragmatic reason is fairly simple: users of object-oriented languages want
something like a ``shallow object value equality''.
You will want to say
\inlineisar+ a.boss ≜ b.boss@pre +
instead of
\begin{isar}
a.boss ≐ b.boss@pre and (* just the pointers are equal! *)
a.boss.name ≐ b.boss@pre.name@pre and
a.boss.age ≐ b.boss@pre.age@pre
\end{isar}
Breaking a shallow-object equality down to referential equality
of attributes is cumbersome, error-prone, and makes
specifications difficult to extend (add for example an attribute
sex to your class, and check in your OCL specification
everywhere that you did it right with your simulation of strong
equality). Therefore, languages like Java offer facilities
to handle two different equalities, and it is problematic even
in an execution oriented specification language to ignore
shallow object equality because it is so common in the code.
\item The fundamental reason goes as follows: whatever you do to
reason consistently over a language, you need the concept of
equality: you need to know what expressions can be replaced by
others because they \emph{mean the same thing.} People call
this also ``Leibniz Equality'' because this philosopher brought
this principle first explicitly to paper and shed some light
over it. It is the theoretic foundation of what you do in an
optimizing compiler: you replace expressions by \emph{equal}
ones, which you hope are easier to evaluate. In a typed
language, strong equality exists uniformly over all types, it is
``polymorphic'' $\_ = \_ :: \alpha * \alpha \rightarrow
bool$---this is the way that equality is defined in HOL itself.
We can express Leibniz principle as one logical rule of
surprising simplicity and beauty:
\begin{gather}
s = t \Longrightarrow P(s) = P(t)
\end{gather}
``Whenever we know, that $s$ is equal to $t$, we can replace the
sub-expression $s$ in a term $P$ by $t$ and we have that the
replacement is equal to the original.''
\end{enumerate}
›
text‹
While weak referential equality is defined to be strict in the OCL
standard, we will define strong equality as non-strict. It is quite
nasty (but not impossible) to define the logical equality in a
strict way (the substitutivity rule above would look more complex),
however, whenever references were used, strong equality is needed
since references refer to particular states (pre or post), and that
they mean the same thing can therefore not be taken for granted.
›
subsubsection‹Definition›
text‹
The strict equality on basic types (actually on all types) must be
exceptionally defined on @{term "null"}---otherwise the entire
concept of null in the language does not make much sense. This is an
important exception from the general rule that null
arguments---especially if passed as ``self''-argument---lead to
invalid results.
›
text‹
We define strong equality extremely generic, even for types that
contain a ‹null› or ‹⊥› element. Strong
equality is simply polymorphic in Featherweight OCL, \ie, is
defined identical for all types in OCL and HOL.
›
definition StrongEq::"['𝔄 st ⇒ 'α,'𝔄 st ⇒ 'α] ⇒ ('𝔄)Boolean" (infixl "≜" 30)
where "X ≜ Y ≡ λ τ. ⌊⌊X τ = Y τ ⌋⌋"
text‹
From this follow already elementary properties like:
›
lemma [simp,code_unfold]: "(true ≜ false) = false"
by(rule ext, auto simp: StrongEq_def)
lemma [simp,code_unfold]: "(false ≜ true) = false"
by(rule ext, auto simp: StrongEq_def)
subsubsection‹Fundamental Predicates on Strong Equality›
text‹Equality reasoning in OCL is not humpty dumpty. While strong equality
is clearly an equivalence:›
lemma StrongEq_refl [simp]: "(X ≜ X) = true"
by(rule ext, simp add: null_def invalid_def true_def false_def StrongEq_def)
lemma StrongEq_sym: "(X ≜ Y) = (Y ≜ X)"
by(rule ext, simp add: eq_sym_conv invalid_def true_def false_def StrongEq_def)
lemma StrongEq_trans_strong [simp]:
assumes A: "(X ≜ Y) = true"
and B: "(Y ≜ Z) = true"
shows "(X ≜ Z) = true"
apply(insert A B) apply(rule ext)
apply(simp add: null_def invalid_def true_def false_def StrongEq_def)
apply(drule_tac x=x in fun_cong)+
by auto
text‹
it is only in a limited sense a congruence, at least from the
point of view of this semantic theory. The point is that it is
only a congruence on OCL expressions, not arbitrary HOL
expressions (with which we can mix Featherweight OCL expressions). A
semantic---not syntactic---characterization of OCL expressions is
that they are \emph{context-passing} or \emph{context-invariant},
\ie, the context of an entire OCL expression, \ie the pre and
post state it referes to, is passed constantly and unmodified to
the sub-expressions, \ie, all sub-expressions inside an OCL
expression refer to the same context. Expressed formally, this
boils down to:
›
lemma StrongEq_subst :
assumes cp: "⋀X. P(X)τ = P(λ _. X τ)τ"
and eq: "(X ≜ Y)τ = true τ"
shows "(P X ≜ P Y)τ = true τ"
apply(insert cp eq)
apply(simp add: null_def invalid_def true_def false_def StrongEq_def)
apply(subst cp[of X])
apply(subst cp[of Y])
by simp
lemma defined7[simp]: "δ (X ≜ Y) = true"
by(rule ext,
auto simp: defined_def true_def false_def StrongEq_def
bot_fun_def bot_option_def null_option_def null_fun_def)
lemma valid7[simp]: "υ (X ≜ Y) = true"
by(rule ext,
auto simp: valid_def true_def false_def StrongEq_def
bot_fun_def bot_option_def null_option_def null_fun_def)
lemma cp_StrongEq: "(X ≜ Y) τ = ((λ _. X τ) ≜ (λ _. Y τ)) τ"
by(simp add: StrongEq_def)
subsection‹Logical Connectives and their Universal Properties›
text‹
It is a design goal to give OCL a semantics that is as closely as
possible to a ``logical system'' in a known sense; a specification
logic where the logical connectives can not be understood other that
having the truth-table aside when reading fails its purpose in our
view.
Practically, this means that we want to give a definition to the
core operations to be as close as possible to the lattice laws; this
makes also powerful symbolic normalization of OCL specifications
possible as a pre-requisite for automated theorem provers. For
example, it is still possible to compute without any definedness
and validity reasoning the DNF of an OCL specification; be it for
test-case generations or for a smooth transition to a two-valued
representation of the specification amenable to fast standard
SMT-solvers, for example.
Thus, our representation of the OCL is merely a 4-valued
Kleene-Logics with @{term "invalid"} as least, @{term "null"} as
middle and @{term "true"} resp. @{term "false"} as unrelated
top-elements.
›
definition OclNot :: "('𝔄)Boolean ⇒ ('𝔄)Boolean" ("not")
where "not X ≡ λ τ . case X τ of
⊥ ⇒ ⊥
| ⌊ ⊥ ⌋ ⇒ ⌊ ⊥ ⌋
| ⌊⌊ x ⌋⌋ ⇒ ⌊⌊ ¬ x ⌋⌋"
lemma cp_OclNot: "(not X)τ = (not (λ _. X τ)) τ"
by(simp add: OclNot_def)
lemma OclNot1[simp]: "not invalid = invalid"
by(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def bot_option_def)
lemma OclNot2[simp]: "not null = null"
by(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def
bot_option_def null_fun_def null_option_def )
lemma OclNot3[simp]: "not true = false"
by(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def)
lemma OclNot4[simp]: "not false = true"
by(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def)
lemma OclNot_not[simp]: "not (not X) = X"
apply(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def)
apply(case_tac "X x", simp_all)
apply(case_tac "a", simp_all)
done
lemma OclNot_inject: "⋀ x y. not x = not y ⟹ x = y"
by(subst OclNot_not[THEN sym], simp)
definition OclAnd :: "[('𝔄)Boolean, ('𝔄)Boolean] ⇒ ('𝔄)Boolean" (infixl "and" 30)
where "X and Y ≡ (λ τ . case X τ of
⌊⌊False⌋⌋ ⇒ ⌊⌊False⌋⌋
| ⊥ ⇒ (case Y τ of
⌊⌊False⌋⌋ ⇒ ⌊⌊False⌋⌋
| _ ⇒ ⊥)
| ⌊⊥⌋ ⇒ (case Y τ of
⌊⌊False⌋⌋ ⇒ ⌊⌊False⌋⌋
| ⊥ ⇒ ⊥
| _ ⇒ ⌊⊥⌋)
| ⌊⌊True⌋⌋ ⇒ Y τ)"
text‹
Note that @{term "not"} is \emph{not} defined as a strict function;
proximity to lattice laws implies that we \emph{need} a definition
of @{term "not"} that satisfies ‹not(not(x))=x›.
›
text‹
In textbook notation, the logical core constructs @{const
"OclNot"} and @{const "OclAnd"} were represented as follows:
›
lemma textbook_OclNot:
"I⟦not(X)⟧ τ = (case I⟦X⟧ τ of ⊥ ⇒ ⊥
| ⌊ ⊥ ⌋ ⇒ ⌊ ⊥ ⌋
| ⌊⌊ x ⌋⌋ ⇒ ⌊⌊ ¬ x ⌋⌋)"
by(simp add: Sem_def OclNot_def)
lemma textbook_OclAnd:
"I⟦X and Y⟧ τ = (case I⟦X⟧ τ of
⊥ ⇒ (case I⟦Y⟧ τ of
⊥ ⇒ ⊥
| ⌊⊥⌋ ⇒ ⊥
| ⌊⌊True⌋⌋ ⇒ ⊥
| ⌊⌊False⌋⌋ ⇒ ⌊⌊False⌋⌋)
| ⌊ ⊥ ⌋ ⇒ (case I⟦Y⟧ τ of
⊥ ⇒ ⊥
| ⌊⊥⌋ ⇒ ⌊⊥⌋
| ⌊⌊True⌋⌋ ⇒ ⌊⊥⌋
| ⌊⌊False⌋⌋ ⇒ ⌊⌊False⌋⌋)
| ⌊⌊True⌋⌋ ⇒ (case I⟦Y⟧ τ of
⊥ ⇒ ⊥
| ⌊⊥⌋ ⇒ ⌊⊥⌋
| ⌊⌊y⌋⌋ ⇒ ⌊⌊y⌋⌋)
| ⌊⌊False⌋⌋ ⇒ ⌊⌊ False ⌋⌋)"
by(simp add: OclAnd_def Sem_def split: option.split bool.split)
definition OclOr :: "[('𝔄)Boolean, ('𝔄)Boolean] ⇒ ('𝔄)Boolean" (infixl "or" 25)
where "X or Y ≡ not(not X and not Y)"
definition OclImplies :: "[('𝔄)Boolean, ('𝔄)Boolean] ⇒ ('𝔄)Boolean" (infixl "implies" 25)
where "X implies Y ≡ not X or Y"
lemma cp_OclAnd:"(X and Y) τ = ((λ _. X τ) and (λ _. Y τ)) τ"
by(simp add: OclAnd_def)
lemma cp_OclOr:"((X::('𝔄)Boolean) or Y) τ = ((λ _. X τ) or (λ _. Y τ)) τ"
apply(simp add: OclOr_def)
apply(subst cp_OclNot[of "not (λ_. X τ) and not (λ_. Y τ)"])
apply(subst cp_OclAnd[of "not (λ_. X τ)" "not (λ_. Y τ)"])
by(simp add: cp_OclNot[symmetric] cp_OclAnd[symmetric] )
lemma cp_OclImplies:"(X implies Y) τ = ((λ _. X τ) implies (λ _. Y τ)) τ"
apply(simp add: OclImplies_def)
apply(subst cp_OclOr[of "not (λ_. X τ)" "(λ_. Y τ)"])
by(simp add: cp_OclNot[symmetric] cp_OclOr[symmetric] )
lemma OclAnd1[simp]: "(invalid and true) = invalid"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def)
lemma OclAnd2[simp]: "(invalid and false) = false"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def)
lemma OclAnd3[simp]: "(invalid and null) = invalid"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def
null_fun_def null_option_def)
lemma OclAnd4[simp]: "(invalid and invalid) = invalid"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def)
lemma OclAnd5[simp]: "(null and true) = null"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def
null_fun_def null_option_def)
lemma OclAnd6[simp]: "(null and false) = false"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def
null_fun_def null_option_def)
lemma OclAnd7[simp]: "(null and null) = null"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def
null_fun_def null_option_def)
lemma OclAnd8[simp]: "(null and invalid) = invalid"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def
null_fun_def null_option_def)
lemma OclAnd9[simp]: "(false and true) = false"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def)
lemma OclAnd10[simp]: "(false and false) = false"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def)
lemma OclAnd11[simp]: "(false and null) = false"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def)
lemma OclAnd12[simp]: "(false and invalid) = false"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def)
lemma OclAnd13[simp]: "(true and true) = true"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def)
lemma OclAnd14[simp]: "(true and false) = false"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def)
lemma OclAnd15[simp]: "(true and null) = null"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def
null_fun_def null_option_def)
lemma OclAnd16[simp]: "(true and invalid) = invalid"
by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def
null_fun_def null_option_def)
lemma OclAnd_idem[simp]: "(X and X) = X"
apply(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def)
apply(case_tac "X x", simp_all)
apply(case_tac "a", simp_all)
apply(case_tac "aa", simp_all)
done
lemma OclAnd_commute: "(X and Y) = (Y and X)"
by(rule ext,auto simp:true_def false_def OclAnd_def invalid_def
split: option.split option.split_asm
bool.split bool.split_asm)
lemma OclAnd_false1[simp]: "(false and X) = false"
apply(rule ext, simp add: OclAnd_def)
apply(auto simp:true_def false_def invalid_def
split: option.split option.split_asm)
done
lemma OclAnd_false2[simp]: "(X and false) = false"
by(simp add: OclAnd_commute)
lemma OclAnd_true1[simp]: "(true and X) = X"
apply(rule ext, simp add: OclAnd_def)
apply(auto simp:true_def false_def invalid_def
split: option.split option.split_asm)
done
lemma OclAnd_true2[simp]: "(X and true) = X"
by(simp add: OclAnd_commute)
lemma OclAnd_bot1[simp]: "⋀τ. X τ ≠ false τ ⟹ (bot and X) τ = bot τ"
apply(simp add: OclAnd_def)
apply(auto simp:true_def false_def bot_fun_def bot_option_def
split: option.split option.split_asm)
done
lemma OclAnd_bot2[simp]: "⋀τ. X τ ≠ false τ ⟹ (X and bot) τ = bot τ"
by(simp add: OclAnd_commute)
lemma OclAnd_null1[simp]: "⋀τ. X τ ≠ false τ ⟹ X τ ≠ bot τ ⟹ (null and X) τ = null τ"
apply(simp add: OclAnd_def)
apply(auto simp:true_def false_def bot_fun_def bot_option_def null_fun_def null_option_def
split: option.split option.split_asm)
done
lemma OclAnd_null2[simp]: "⋀τ. X τ ≠ false τ ⟹ X τ ≠ bot τ ⟹ (X and null) τ = null τ"
by(simp add: OclAnd_commute)
lemma OclAnd_assoc: "(X and (Y and Z)) = (X and Y and Z)"
apply(rule ext, simp add: OclAnd_def)
apply(auto simp:true_def false_def null_def invalid_def
split: option.split option.split_asm
bool.split bool.split_asm)
done
lemma OclOr1[simp]: "(invalid or true) = true"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
bot_option_def)
lemma OclOr2[simp]: "(invalid or false) = invalid"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
bot_option_def)
lemma OclOr3[simp]: "(invalid or null) = invalid"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
bot_option_def null_fun_def null_option_def)
lemma OclOr4[simp]: "(invalid or invalid) = invalid"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
bot_option_def)
lemma OclOr5[simp]: "(null or true) = true"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
bot_option_def null_fun_def null_option_def)
lemma OclOr6[simp]: "(null or false) = null"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
bot_option_def null_fun_def null_option_def)
lemma OclOr7[simp]: "(null or null) = null"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
bot_option_def null_fun_def null_option_def)
lemma OclOr8[simp]: "(null or invalid) = invalid"
by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def
bot_option_def null_fun_def null_option_def)
lemma OclOr_idem[simp]: "(X or X) = X"
by(simp add: OclOr_def)
lemma OclOr_commute: "(X or Y) = (Y or X)"
by(simp add: OclOr_def OclAnd_commute)
lemma OclOr_false1[simp]: "(false or Y) = Y"
by(simp add: OclOr_def)
lemma OclOr_false2[simp]: "(Y or false) = Y"
by(simp add: OclOr_def)
lemma OclOr_true1[simp]: "(true or Y) = true"
by(simp add: OclOr_def)
lemma OclOr_true2: "(Y or true) = true"
by(simp add: OclOr_def)
lemma OclOr_bot1[simp]: "⋀τ. X τ ≠ true τ ⟹ (bot or X) τ = bot τ"
apply(simp add: OclOr_def OclAnd_def OclNot_def)
apply(auto simp:true_def false_def bot_fun_def bot_option_def
split: option.split option.split_asm)
done
lemma OclOr_bot2[simp]: "⋀τ. X τ ≠ true τ ⟹ (X or bot) τ = bot τ"
by(simp add: OclOr_commute)
lemma OclOr_null1[simp]: "⋀τ. X τ ≠ true τ ⟹ X τ ≠ bot τ ⟹ (null or X) τ = null τ"
apply(simp add: OclOr_def OclAnd_def OclNot_def)
apply(auto simp:true_def false_def bot_fun_def bot_option_def null_fun_def null_option_def
split: option.split option.split_asm)
apply (metis (full_types) bool.simps(3) bot_option_def null_is_valid null_option_def)
by (metis (full_types) bool.simps(3) option.distinct(1) option.sel)
lemma OclOr_null2[simp]: "⋀τ. X τ ≠ true τ ⟹ X τ ≠ bot τ ⟹ (X or null) τ = null τ"
by(simp add: OclOr_commute)
lemma OclOr_assoc: "(X or (Y or Z)) = (X or Y or Z)"
by(simp add: OclOr_def OclAnd_assoc)
lemma deMorgan1: "not(X and Y) = ((not X) or (not Y))"
by(simp add: OclOr_def)
lemma deMorgan2: "not(X or Y) = ((not X) and (not Y))"
by(simp add: OclOr_def)
lemma OclImplies_true1[simp]:"(true implies X) = X"
by(simp add: OclImplies_def)
lemma OclImplies_true2[simp]: "(X implies true) = true"
by(simp add: OclImplies_def OclOr_true2)
lemma OclImplies_false1[simp]:"(false implies X) = true"
by(simp add: OclImplies_def)
subsection‹A Standard Logical Calculus for OCL›
definition OclValid :: "[('𝔄)st, ('𝔄)Boolean] ⇒ bool" ("(1(_)/ ⊨ (_))" 50)
where "τ ⊨ P ≡ ((P τ) = true τ)"
syntax OclNonValid :: "[('𝔄)st, ('𝔄)Boolean] ⇒ bool" ("(1(_)/ |≠ (_))" 50)
translations "τ |≠ P" == "¬(τ ⊨ P)"
subsubsection‹Global vs. Local Judgements›
lemma transform1: "P = true ⟹ τ ⊨ P"
by(simp add: OclValid_def)
lemma transform1_rev: "∀ τ. τ ⊨ P ⟹ P = true"
by(rule ext, auto simp: OclValid_def true_def)
lemma transform2: "(P = Q) ⟹ ((τ ⊨ P) = (τ ⊨ Q))"
by(auto simp: OclValid_def)
lemma transform2_rev: "∀ τ. (τ ⊨ δ P) ∧ (τ ⊨ δ Q) ∧ (τ ⊨ P) = (τ ⊨ Q) ⟹ P = Q"
apply(rule ext,auto simp: OclValid_def true_def defined_def)
apply(erule_tac x=a in allE)
apply(erule_tac x=b in allE)
apply(auto simp: false_def true_def defined_def bot_Boolean_def null_Boolean_def
split: option.split_asm HOL.if_split_asm)
done
text‹However, certain properties (like transitivity) can not
be \emph{transformed} from the global level to the local one,
they have to be re-proven on the local level.›
lemma
assumes H : "P = true ⟹ Q = true"
shows "τ ⊨ P ⟹ τ ⊨ Q"
apply(simp add: OclValid_def)
apply(rule H[THEN fun_cong])
apply(rule ext)
oops
subsubsection‹Local Validity and Meta-logic›
text‹\label{sec:localVal}›
lemma foundation1[simp]: "τ ⊨ true"
by(auto simp: OclValid_def)
lemma foundation2[simp]: "¬(τ ⊨ false)"
by(auto simp: OclValid_def true_def false_def)
lemma foundation3[simp]: "¬(τ ⊨ invalid)"
by(auto simp: OclValid_def true_def false_def invalid_def bot_option_def)
lemma foundation4[simp]: "¬(τ ⊨ null)"
by(auto simp: OclValid_def true_def false_def null_def null_fun_def null_option_def bot_option_def)
lemma bool_split[simp]:
"(τ ⊨ (x ≜ invalid)) ∨ (τ ⊨ (x ≜ null)) ∨ (τ ⊨ (x ≜ true)) ∨ (τ ⊨ (x ≜ false))"
apply(insert bool_split_0[of x τ], auto)
apply(simp_all add: OclValid_def StrongEq_def true_def null_def invalid_def)
done
lemma defined_split:
"(τ ⊨ δ x) = ((¬(τ ⊨ (x ≜ invalid))) ∧ (¬ (τ ⊨ (x ≜ null))))"
by(simp add:defined_def true_def false_def invalid_def null_def
StrongEq_def OclValid_def bot_fun_def null_fun_def)
lemma valid_bool_split: "(τ ⊨ υ A) = ((τ ⊨ A ≜ null) ∨ (τ ⊨ A) ∨ (τ ⊨ not A)) "
by(auto simp:valid_def true_def false_def invalid_def null_def OclNot_def
StrongEq_def OclValid_def bot_fun_def bot_option_def null_option_def null_fun_def)
lemma defined_bool_split: "(τ ⊨ δ A) = ((τ ⊨ A) ∨ (τ ⊨ not A))"
by(auto simp:defined_def true_def false_def invalid_def null_def OclNot_def
StrongEq_def OclValid_def bot_fun_def bot_option_def null_option_def null_fun_def)
lemma foundation5:
"τ ⊨ (P and Q) ⟹ (τ ⊨ P) ∧ (τ ⊨ Q)"
by(simp add: OclAnd_def OclValid_def true_def false_def defined_def
split: option.split option.split_asm bool.split bool.split_asm)
lemma foundation6:
"τ ⊨ P ⟹ τ ⊨ δ P"
by(simp add: OclNot_def OclValid_def true_def false_def defined_def
null_option_def null_fun_def bot_option_def bot_fun_def
split: option.split option.split_asm)
lemma foundation7[simp]:
"(τ ⊨ not (δ x)) = (¬ (τ ⊨ δ x))"
by(simp add: OclNot_def OclValid_def true_def false_def defined_def
split: option.split option.split_asm)
lemma foundation7'[simp]:
"(τ ⊨ not (υ x)) = (¬ (τ ⊨ υ x))"
by(simp add: OclNot_def OclValid_def true_def false_def valid_def
split: option.split option.split_asm)
text‹
Key theorem for the $\delta$-closure: either an expression is
defined, or it can be replaced (substituted via ‹StrongEq_L_subst2›;
see below) by ‹invalid› or ‹null›. Strictness-reduction rules will
usually reduce these substituted terms drastically.
›
lemma foundation8:
"(τ ⊨ δ x) ∨ (τ ⊨ (x ≜ invalid)) ∨ (τ ⊨ (x ≜ null))"
proof -
have 1 : "(τ ⊨ δ x) ∨ (¬(τ ⊨ δ x))" by auto
have 2 : "(¬(τ ⊨ δ x)) = ((τ ⊨ (x ≜ invalid)) ∨ (τ ⊨ (x ≜ null)))"
by(simp only: defined_split, simp)
show ?thesis by(insert 1, simp add:2)
qed
lemma foundation9:
"τ ⊨ δ x ⟹ (τ ⊨ not x) = (¬ (τ ⊨ x))"
apply(simp add: defined_split )
by(auto simp: OclNot_def null_fun_def null_option_def bot_option_def
OclValid_def invalid_def true_def null_def StrongEq_def)
lemma foundation9':
"τ ⊨ not x ⟹ ¬ (τ ⊨ x)"
by(auto simp: foundation6 foundation9)
lemma foundation9'':
" τ ⊨ not x ⟹ τ ⊨ δ x"
by(metis OclNot3 OclNot_not OclValid_def cp_OclNot cp_defined defined4)
lemma foundation10:
"τ ⊨ δ x ⟹ τ ⊨ δ y ⟹ (τ ⊨ (x and y)) = ( (τ ⊨ x) ∧ (τ ⊨ y))"
apply(simp add: defined_split)
by(auto simp: OclAnd_def OclValid_def invalid_def
true_def null_def StrongEq_def null_fun_def null_option_def bot_option_def
split:bool.split_asm)
lemma foundation10': "(τ ⊨ (A and B)) = ((τ ⊨ A) ∧ (τ ⊨ B))"
by(auto dest:foundation5 simp:foundation6 foundation10)
lemma foundation11:
"τ ⊨ δ x ⟹ τ ⊨ δ y ⟹ (τ ⊨ (x or y)) = ( (τ ⊨ x) ∨ (τ ⊨ y))"
apply(simp add: defined_split)
by(auto simp: OclNot_def OclOr_def OclAnd_def OclValid_def invalid_def
true_def null_def StrongEq_def null_fun_def null_option_def bot_option_def
split:bool.split_asm bool.split)
lemma foundation12:
"τ ⊨ δ x ⟹ (τ ⊨ (x implies y)) = ( (τ ⊨ x) ⟶ (τ ⊨ y))"
apply(simp add: defined_split)
by(auto simp: OclNot_def OclOr_def OclAnd_def OclImplies_def bot_option_def
OclValid_def invalid_def true_def null_def StrongEq_def null_fun_def null_option_def
split:bool.split_asm bool.split option.split_asm)
lemma foundation13:"(τ ⊨ A ≜ true) = (τ ⊨ A)"
by(auto simp: OclNot_def OclValid_def invalid_def true_def null_def StrongEq_def
split:bool.split_asm bool.split)
lemma foundation14:"(τ ⊨ A ≜ false) = (τ ⊨ not A)"
by(auto simp: OclNot_def OclValid_def invalid_def false_def true_def null_def StrongEq_def
split:bool.split_asm bool.split option.split)
lemma foundation15:"(τ ⊨ A ≜ invalid) = (τ ⊨ not(υ A))"
by(auto simp: OclNot_def OclValid_def valid_def invalid_def false_def true_def null_def
StrongEq_def bot_option_def null_fun_def null_option_def bot_option_def bot_fun_def
split:bool.split_asm bool.split option.split)
lemma foundation16: "τ ⊨ (δ X) = (X τ ≠ bot ∧ X τ ≠ null)"
by(auto simp: OclValid_def defined_def false_def true_def bot_fun_def null_fun_def
split:if_split_asm)
lemma foundation16'': "¬(τ ⊨ (δ X)) = ((τ ⊨ (X ≜ invalid)) ∨ (τ ⊨ (X ≜ null)))"
apply(simp add: foundation16)
by(auto simp:defined_def false_def true_def bot_fun_def null_fun_def OclValid_def StrongEq_def invalid_def)
lemma foundation16': "(τ ⊨ (δ X)) = (X τ ≠ invalid τ ∧ X τ ≠ null τ)"
apply(simp add:invalid_def null_def null_fun_def)
by(auto simp: OclValid_def defined_def false_def true_def bot_fun_def null_fun_def
split:if_split_asm)
lemma foundation18: "(τ ⊨ (υ X)) = (X τ ≠ invalid τ)"
by(auto simp: OclValid_def valid_def false_def true_def bot_fun_def invalid_def
split:if_split_asm)
lemma foundation18': "(τ ⊨ (υ X)) = (X τ ≠ bot)"
by(auto simp: OclValid_def valid_def false_def true_def bot_fun_def
split:if_split_asm)
lemma foundation18'': "(τ ⊨ (υ X) )= (¬(τ ⊨ (X ≜ invalid)))"
by(auto simp:foundation15)
lemma foundation20 : "τ ⊨ (δ X) ⟹ τ ⊨ υ X"
by(simp add: foundation18 foundation16 invalid_def)
lemma foundation21: "(not A ≜ not B) = (A ≜ B)"
by(rule ext, auto simp: OclNot_def StrongEq_def
split: bool.split_asm HOL.if_split_asm option.split)
lemma foundation22: "(τ ⊨ (X ≜ Y)) = (X τ = Y τ)"
by(auto simp: StrongEq_def OclValid_def true_def)
lemma foundation23: "(τ ⊨ P) = (τ ⊨ (λ _ . P τ))"
by(auto simp: OclValid_def true_def)
lemma foundation24:"(τ ⊨ not(X ≜ Y)) = (X τ ≠ Y τ)"
by(simp add: StrongEq_def OclValid_def OclNot_def true_def)
lemma foundation25: "τ ⊨ P ⟹ τ ⊨ (P or Q)"
by(simp add: OclOr_def OclNot_def OclAnd_def OclValid_def true_def)
lemma foundation25': "τ ⊨ Q ⟹ τ ⊨ (P or Q)"
by(subst OclOr_commute, simp add: foundation25)
lemma foundation26:
assumes defP: "τ ⊨ δ P"
assumes defQ: "τ ⊨ δ Q"
assumes H: "τ ⊨ (P or Q)"
assumes P: "τ ⊨ P ⟹ R"
assumes Q: "τ ⊨ Q ⟹ R"
shows "R"
by(insert H, subst (asm) foundation11[OF defP defQ], erule disjE, simp_all add: P Q)
lemma foundation27: "τ ⊨ A ⟹ (τ ⊨ A implies B) = (τ ⊨ B)"
by (simp add: foundation12 foundation6)
lemma defined_not_I : "τ ⊨ δ (x) ⟹ τ ⊨ δ (not x)"
by(auto simp: OclNot_def null_def invalid_def defined_def valid_def OclValid_def
true_def false_def bot_option_def null_option_def null_fun_def bot_fun_def
split: option.split_asm HOL.if_split_asm)
lemma valid_not_I : "τ ⊨ υ (x) ⟹ τ ⊨ υ (not x)"
by(auto simp: OclNot_def null_def invalid_def defined_def valid_def OclValid_def
true_def false_def bot_option_def null_option_def null_fun_def bot_fun_def
split: option.split_asm option.split HOL.if_split_asm)
lemma defined_and_I : "τ ⊨ δ (x) ⟹ τ ⊨ δ (y) ⟹ τ ⊨ δ (x and y)"
apply(simp add: OclAnd_def null_def invalid_def defined_def valid_def OclValid_def
true_def false_def bot_option_def null_option_def null_fun_def bot_fun_def
split: option.split_asm HOL.if_split_asm)
apply(auto simp: null_option_def split: bool.split)
by(case_tac "ya",simp_all)
lemma valid_and_I : "τ ⊨ υ (x) ⟹ τ ⊨ υ (y) ⟹ τ ⊨ υ (x and y)"
apply(simp add: OclAnd_def null_def invalid_def defined_def valid_def OclValid_def
true_def false_def bot_option_def null_option_def null_fun_def bot_fun_def
split: option.split_asm HOL.if_split_asm)
by(auto simp: null_option_def split: option.split bool.split)
lemma defined_or_I : "τ ⊨ δ (x) ⟹ τ ⊨ δ (y) ⟹ τ ⊨ δ (x or y)"
by(simp add: OclOr_def defined_and_I defined_not_I)
lemma valid_or_I : "τ ⊨ υ (x) ⟹ τ ⊨ υ (y) ⟹ τ ⊨ υ (x or y)"
by(simp add: OclOr_def valid_and_I valid_not_I)
subsubsection‹Local Judgements and Strong Equality›
lemma StrongEq_L_refl: "τ ⊨ (x ≜ x)"
by(simp add: OclValid_def StrongEq_def)
lemma StrongEq_L_sym: "τ ⊨ (x ≜ y) ⟹ τ ⊨ (y ≜ x)"
by(simp add: StrongEq_sym)
lemma StrongEq_L_trans: "τ ⊨ (x ≜ y) ⟹ τ ⊨ (y ≜ z) ⟹ τ ⊨ (x ≜ z)"
by(simp add: OclValid_def StrongEq_def true_def)
text‹In order to establish substitutivity (which does not
hold in general HOL formulas) we introduce the following
predicate that allows for a calculus of the necessary side-conditions.›
definition cp :: "(('𝔄,'α) val ⇒ ('𝔄,'β) val) ⇒ bool"
where "cp P ≡ (∃ f. ∀ X τ. P X τ = f (X τ) τ)"
text‹The rule of substitutivity in Featherweight OCL holds only
for context-passing expressions, \ie those that pass
the context ‹τ› without changing it. Fortunately, all
operators of the OCL language satisfy this property
(but not all HOL operators).›
lemma StrongEq_L_subst1: "⋀ τ. cp P ⟹ τ ⊨ (x ≜ y) ⟹ τ ⊨ (P x ≜ P y)"
by(auto simp: OclValid_def StrongEq_def true_def cp_def)
lemma StrongEq_L_subst2:
"⋀ τ. cp P ⟹ τ ⊨ (x ≜ y) ⟹ τ ⊨ (P x) ⟹ τ ⊨ (P y)"
by(auto simp: OclValid_def StrongEq_def true_def cp_def)
lemma StrongEq_L_subst2_rev: "τ ⊨ y ≜ x ⟹ cp P ⟹ τ ⊨ P x ⟹ τ ⊨ P y"
apply(erule StrongEq_L_subst2)
apply(erule StrongEq_L_sym)
by assumption
lemma StrongEq_L_subst3:
assumes cp: "cp P"
and eq: "τ ⊨ (x ≜ y)"
shows "(τ ⊨ P x) = (τ ⊨ P y)"
apply(rule iffI)
apply(rule StrongEq_L_subst2[OF cp,OF eq],simp)
apply(rule StrongEq_L_subst2[OF cp,OF eq[THEN StrongEq_L_sym]],simp)
done
lemma StrongEq_L_subst3_rev:
assumes eq: "τ ⊨ (x ≜ y)"
and cp: "cp P"
shows "(τ ⊨ P x) = (τ ⊨ P y)"
by(insert cp, erule StrongEq_L_subst3, rule eq)
lemma StrongEq_L_subst4_rev:
assumes eq: "τ ⊨ (x ≜ y)"
and cp: "cp P"
shows "(¬(τ ⊨ P x)) = (¬(τ ⊨ P y))"
thm arg_cong[of _ _ "Not"]
apply(rule arg_cong[of _ _ "Not"])
by(insert cp, erule StrongEq_L_subst3, rule eq)
lemma cpI1:
"(∀ X τ. f X τ = f(λ_. X τ) τ) ⟹ cp P ⟹ cp(λX. f (P X))"
apply(auto simp: true_def cp_def)
apply(rule exI, (rule allI)+)
by(erule_tac x="P X" in allE, auto)
lemma cpI2:
"(∀ X Y τ. f X Y τ = f(λ_. X τ)(λ_. Y τ) τ) ⟹
cp P ⟹ cp Q ⟹ cp(λX. f (P X) (Q X))"
apply(auto simp: true_def cp_def)
apply(rule exI, (rule allI)+)
by(erule_tac x="P X" in allE, auto)
lemma cpI3:
"(∀ X Y Z τ. f X Y Z τ = f(λ_. X τ)(λ_. Y τ)(λ_. Z τ) τ) ⟹
cp P ⟹ cp Q ⟹ cp R ⟹ cp(λX. f (P X) (Q X) (R X))"
apply(auto simp: cp_def)
apply(rule exI, (rule allI)+)
by(erule_tac x="P X" in allE, auto)
lemma cpI4:
"(∀ W X Y Z τ. f W X Y Z τ = f(λ_. W τ)(λ_. X τ)(λ_. Y τ)(λ_. Z τ) τ) ⟹
cp P ⟹ cp Q ⟹ cp R ⟹ cp S ⟹ cp(λX. f (P X) (Q X) (R X) (S X))"
apply(auto simp: cp_def)
apply(rule exI, (rule allI)+)
by(erule_tac x="P X" in allE, auto)
lemma cpI5:
"(∀ V W X Y Z τ. f V W X Y Z τ = f(λ_. V τ) (λ_. W τ)(λ_. X τ)(λ_. Y τ)(λ_. Z τ) τ) ⟹
cp N ⟹ cp P ⟹ cp Q ⟹ cp R ⟹ cp S ⟹ cp(λX. f (N X) (P X) (Q X) (R X) (S X))"
apply(auto simp: cp_def)
apply(rule exI, (rule allI)+)
by(erule_tac x="N X" in allE, auto)
lemma cp_const : "cp(λ_. c)"
by (simp add: cp_def, fast)
lemma cp_id : "cp(λX. X)"
by (simp add: cp_def, fast)
text_raw‹\isatagafp›
lemmas cp_intro[intro!,simp,code_unfold] =
cp_const
cp_id
cp_defined[THEN allI[THEN allI[THEN cpI1], of defined]]
cp_valid[THEN allI[THEN allI[THEN cpI1], of valid]]
cp_OclNot[THEN allI[THEN allI[THEN cpI1], of not]]
cp_OclAnd[THEN allI[THEN allI[THEN allI[THEN cpI2]], of "(and)"]]
cp_OclOr[THEN allI[THEN allI[THEN allI[THEN cpI2]], of "(or)"]]
cp_OclImplies[THEN allI[THEN allI[THEN allI[THEN cpI2]], of "(implies)"]]
cp_StrongEq[THEN allI[THEN allI[THEN allI[THEN cpI2]],
of "StrongEq"]]
text_raw‹\endisatagafp›
subsection‹OCL's if then else endif›
definition OclIf :: "[('𝔄)Boolean , ('𝔄,'α::null) val, ('𝔄,'α) val] ⇒ ('𝔄,'α) val"
("if (_) then (_) else (_) endif" [10,10,10]50)
where "(if C then B⇩1 else B⇩2 endif) = (λ τ. if (δ C) τ = true τ
then (if (C τ) = true τ
then B⇩1 τ
else B⇩2 τ)
else invalid τ)"
lemma cp_OclIf:"((if C then B⇩1 else B⇩2 endif) τ =
(if (λ _. C τ) then (λ _. B⇩1 τ) else (λ _. B⇩2 τ) endif) τ)"
by(simp only: OclIf_def, subst cp_defined, rule refl)
text_raw‹\isatagafp›
lemmas cp_intro'[intro!,simp,code_unfold] =
cp_intro
cp_OclIf[THEN allI[THEN allI[THEN allI[THEN allI[THEN cpI3]]], of "OclIf"]]
text_raw‹\endisatagafp›
lemma OclIf_invalid [simp]: "(if invalid then B⇩1 else B⇩2 endif) = invalid"
by(rule ext, auto simp: OclIf_def)
lemma OclIf_null [simp]: "(if null then B⇩1 else B⇩2 endif) = invalid"
by(rule ext, auto simp: OclIf_def)
lemma OclIf_true [simp]: "(if true then B⇩1 else B⇩2 endif) = B⇩1"
by(rule ext, auto simp: OclIf_def)
lemma OclIf_true' [simp]: "τ ⊨ P ⟹ (if P then B⇩1 else B⇩2 endif)τ = B⇩1 τ"
apply(subst cp_OclIf,auto simp: OclValid_def)
by(simp add:cp_OclIf[symmetric])
lemma OclIf_true'' [simp]: "τ ⊨ P ⟹ τ ⊨ (if P then B⇩1 else B⇩2 endif) ≜ B⇩1"
by(subst OclValid_def, simp add: StrongEq_def true_def)
lemma OclIf_false [simp]: "(if false then B⇩1 else B⇩2 endif) = B⇩2"
by(rule ext, auto simp: OclIf_def)
lemma OclIf_false' [simp]: "τ ⊨ not P ⟹ (if P then B⇩1 else B⇩2 endif)τ = B⇩2 τ"
apply(subst cp_OclIf)
apply(auto simp: foundation14[symmetric] foundation22)
by(auto simp: cp_OclIf[symmetric])
lemma OclIf_idem1[simp]:"(if δ X then A else A endif) = A"
by(rule ext, auto simp: OclIf_def)
lemma OclIf_idem2[simp]:"(if υ X then A else A endif) = A"
by(rule ext, auto simp: OclIf_def)
lemma OclNot_if[simp]:
"not(if P then C else E endif) = (if P then not C else not E endif)"
apply(rule OclNot_inject, simp)
apply(rule ext)
apply(subst cp_OclNot, simp add: OclIf_def)
apply(subst cp_OclNot[symmetric])+
by simp
subsection‹Fundamental Predicates on Basic Types: Strict (Referential) Equality›
text‹
In contrast to logical equality, the OCL standard defines an equality operation
which we call ``strict referential equality''. It behaves differently for all
types---on value types, it is basically a strict version of strong equality,
for defined values it behaves identical. But on object types it will compare
their references within the store. We introduce strict referential equality
as an \emph{overloaded} concept and will handle it for
each type instance individually.
›
consts StrictRefEq :: "[('𝔄,'a)val,('𝔄,'a)val] ⇒ ('𝔄)Boolean" (infixl "≐" 30)
text‹with {term "not"} we can express the notation:›
syntax
"notequal" :: "('𝔄)Boolean ⇒ ('𝔄)Boolean ⇒ ('𝔄)Boolean" (infix "<>" 40)
translations
"a <> b" == "CONST OclNot(a ≐ b)"
text‹We will define instances of this equality in a case-by-case basis.›
subsection‹Laws to Establish Definedness (\texorpdfstring{$\delta$}{d}-closure)›
text‹For the logical connectives, we have --- beyond
@{thm foundation6} --- the following facts:›
lemma OclNot_defargs:
"τ ⊨ (not P) ⟹ τ ⊨ δ P"
by(auto simp: OclNot_def OclValid_def true_def invalid_def defined_def false_def
bot_fun_def bot_option_def null_fun_def null_option_def
split: bool.split_asm HOL.if_split_asm option.split option.split_asm)
lemma OclNot_contrapos_nn:
assumes A: "τ ⊨ δ A"
assumes B: "τ ⊨ not B"
assumes C: "τ ⊨ A ⟹ τ ⊨ B"
shows "τ ⊨ not A"
proof -
have D : "τ ⊨ δ B" by(rule B[THEN OclNot_defargs])
show ?thesis
apply(insert B,simp add: A D foundation9)
by(erule contrapos_nn, auto intro: C)
qed
subsection‹A Side-calculus for Constant Terms›
definition "const X ≡ ∀ τ τ'. X τ = X τ'"
lemma const_charn: "const X ⟹ X τ = X τ'"
by(auto simp: const_def)
lemma const_subst:
assumes const_X: "const X"
and const_Y: "const Y"
and eq : "X τ = Y τ"
and cp_P: "cp P"
and pp : "P Y τ = P Y τ'"
shows "P X τ = P X τ'"
proof -
have A: "⋀Y. P Y τ = P (λ_. Y τ) τ"
apply(insert cp_P, unfold cp_def)
apply(elim exE, erule_tac x=Y in allE', erule_tac x=τ in allE)
apply(erule_tac x="(λ_. Y τ)" in allE, erule_tac x=τ in allE)
by simp
have B: "⋀Y. P Y τ' = P (λ_. Y τ') τ'"
apply(insert cp_P, unfold cp_def)
apply(elim exE, erule_tac x=Y in allE', erule_tac x=τ' in allE)
apply(erule_tac x="(λ_. Y τ')" in allE, erule_tac x=τ' in allE)
by simp
have C: "X τ' = Y τ'"
apply(rule trans, subst const_charn[OF const_X],rule eq)
by(rule const_charn[OF const_Y])
show ?thesis
apply(subst A, subst B, simp add: eq C)
apply(subst A[symmetric],subst B[symmetric])
by(simp add:pp)
qed
lemma const_imply2 :
assumes "⋀τ τ'. P τ = P τ' ⟹ Q τ = Q τ'"
shows "const P ⟹ const Q"
by(simp add: const_def, insert assms, blast)
lemma const_imply3 :
assumes "⋀τ τ'. P τ = P τ' ⟹ Q τ = Q τ' ⟹ R τ = R τ'"
shows "const P ⟹ const Q ⟹ const R"
by(simp add: const_def, insert assms, blast)
lemma const_imply4 :
assumes "⋀τ τ'. P τ = P τ' ⟹ Q τ = Q τ' ⟹ R τ = R τ' ⟹ S τ = S τ'"
shows "const P ⟹ const Q ⟹ const R ⟹ const S"
by(simp add: const_def, insert assms, blast)
lemma const_lam : "const (λ_. e)"
by(simp add: const_def)
lemma const_true[simp] : "const true"
by(simp add: const_def true_def)
lemma const_false[simp] : "const false"
by(simp add: const_def false_def)
lemma const_null[simp] : "const null"
by(simp add: const_def null_fun_def)
lemma const_invalid [simp]: "const invalid"
by(simp add: const_def invalid_def)
lemma const_bot[simp] : "const bot"
by(simp add: const_def bot_fun_def)
lemma const_defined :
assumes "const X"
shows "const (δ X)"
by(rule const_imply2[OF _ assms],
simp add: defined_def false_def true_def bot_fun_def bot_option_def null_fun_def null_option_def)
lemma const_valid :
assumes "const X"
shows "const (υ X)"
by(rule const_imply2[OF _ assms],
simp add: valid_def false_def true_def bot_fun_def null_fun_def assms)
lemma const_OclAnd :
assumes "const X"
assumes "const X'"
shows "const (X and X')"
by(rule const_imply3[OF _ assms], subst (1 2) cp_OclAnd, simp add: assms OclAnd_def)
lemma const_OclNot :
assumes "const X"
shows "const (not X)"
by(rule const_imply2[OF _ assms],subst cp_OclNot,simp add: assms OclNot_def)
lemma const_OclOr :
assumes "const X"
assumes "const X'"
shows "const (X or X')"
by(simp add: assms OclOr_def const_OclNot const_OclAnd)
lemma const_OclImplies :
assumes "const X"
assumes "const X'"
shows "const (X implies X')"
by(simp add: assms OclImplies_def const_OclNot const_OclOr)
lemma const_StrongEq:
assumes "const X"
assumes "const X'"
shows "const(X ≜ X')"
apply(simp only: StrongEq_def const_def, intro allI)
apply(subst assms(1)[THEN const_charn])
apply(subst assms(2)[THEN const_charn])
by simp
lemma const_OclIf :
assumes "const B"
and "const C1"
and "const C2"
shows "const (if B then C1 else C2 endif)"
apply(rule const_imply4[OF _ assms],
subst (1 2) cp_OclIf, simp only: OclIf_def cp_defined[symmetric])
apply(simp add: const_defined[OF assms(1), simplified const_def, THEN spec, THEN spec]
const_true[simplified const_def, THEN spec, THEN spec]
assms[simplified const_def, THEN spec, THEN spec]
const_invalid[simplified const_def, THEN spec, THEN spec])
by (metis (no_types) bot_fun_def OclValid_def const_def const_true defined_def
foundation16[THEN iffD1] null_fun_def)
lemma const_OclValid1:
assumes "const x"
shows "(τ ⊨ δ x) = (τ' ⊨ δ x)"
apply(simp add: OclValid_def)
apply(subst const_defined[OF assms, THEN const_charn])
by(simp add: true_def)
lemma const_OclValid2:
assumes "const x"
shows "(τ ⊨ υ x) = (τ' ⊨ υ x)"
apply(simp add: OclValid_def)
apply(subst const_valid[OF assms, THEN const_charn])
by(simp add: true_def)
lemma const_HOL_if : "const C ⟹ const D ⟹ const F ⟹ const (λτ. if C τ then D τ else F τ)"
by(auto simp: const_def)
lemma const_HOL_and: "const C ⟹ const D ⟹ const (λτ. C τ ∧ D τ)"
by(auto simp: const_def)
lemma const_HOL_eq : "const C ⟹ const D ⟹ const (λτ. C τ = D τ)"
apply(auto simp: const_def)
apply(erule_tac x=τ in allE)
apply(erule_tac x=τ in allE)
apply(erule_tac x=τ' in allE)
apply(erule_tac x=τ' in allE)
apply simp
apply(erule_tac x=τ in allE)
apply(erule_tac x=τ in allE)
apply(erule_tac x=τ' in allE)
apply(erule_tac x=τ' in allE)
by simp
lemmas const_ss = const_bot const_null const_invalid const_false const_true const_lam
const_defined const_valid const_StrongEq const_OclNot const_OclAnd
const_OclOr const_OclImplies const_OclIf
const_HOL_if const_HOL_and const_HOL_eq
text‹Miscellaneous: Overloading the syntax of ``bottom''›
notation bot ("⊥")
end
Theory UML_PropertyProfiles
theory UML_PropertyProfiles
imports UML_Logic
begin
section‹Property Profiles for OCL Operators via Isabelle Locales›
text‹We use the Isabelle mechanism of a \emph{Locale} to generate the
common lemmas for each type and operator; Locales can be seen as a
functor that takes a local theory and generates a number of theorems.
In our case, we will instantiate later these locales by the local theory
of an operator definition and obtain the common rules for strictness, definedness
propagation, context-passingness and constance in a systematic way.
›
subsection‹Property Profiles for Monadic Operators›
locale profile_mono_scheme_defined =
fixes f :: "('𝔄,'α::null)val ⇒ ('𝔄,'β::null)val"
fixes g
assumes def_scheme: "(f x) ≡ λ τ. if (δ x) τ = true τ then g (x τ) else invalid τ"
begin
lemma strict[simp,code_unfold]: " f invalid = invalid"
by(rule ext, simp add: def_scheme true_def false_def)
lemma null_strict[simp,code_unfold]: " f null = invalid"
by(rule ext, simp add: def_scheme true_def false_def)
lemma cp0 : "f X τ = f (λ _. X τ) τ"
by(simp add: def_scheme cp_defined[symmetric])
lemma cp[simp,code_unfold] : " cp P ⟹ cp (λX. f (P X) )"
by(rule cpI1[of "f"], intro allI, rule cp0, simp_all)
end
locale profile_mono_schemeV =
fixes f :: "('𝔄,'α::null)val ⇒ ('𝔄,'β::null)val"
fixes g
assumes def_scheme: "(f x) ≡ λ τ. if (υ x) τ = true τ then g (x τ) else invalid τ"
begin
lemma strict[simp,code_unfold]: " f invalid = invalid"
by(rule ext, simp add: def_scheme true_def false_def)
lemma cp0 : "f X τ = f (λ _. X τ) τ"
by(simp add: def_scheme cp_valid[symmetric])
lemma cp[simp,code_unfold] : " cp P ⟹ cp (λX. f (P X) )"
by(rule cpI1[of "f"], intro allI, rule cp0, simp_all)
end
locale profile_mono⇩d = profile_mono_scheme_defined +
assumes "⋀ x. x ≠ bot ⟹ x ≠ null ⟹ g x ≠ bot"
begin
lemma const[simp,code_unfold] :
assumes C1 :"const X"
shows "const(f X)"
proof -
have const_g : "const (λτ. g (X τ))" by(insert C1, auto simp:const_def, metis)
show ?thesis by(simp_all add : def_scheme const_ss C1 const_g)
qed
end
locale profile_mono0 = profile_mono_scheme_defined +
assumes def_body: "⋀ x. x ≠ bot ⟹ x ≠ null ⟹ g x ≠ bot ∧ g x ≠ null"
sublocale profile_mono0 < profile_mono⇩d
by(unfold_locales, simp add: def_scheme, simp add: def_body)
context profile_mono0
begin
lemma def_homo[simp,code_unfold]: "δ(f x) = (δ x)"
apply(rule ext, rename_tac "τ",subst foundation22[symmetric])
apply(case_tac "¬(τ ⊨ δ x)", simp add:defined_split, elim disjE)
apply(erule StrongEq_L_subst2_rev, simp,simp)
apply(erule StrongEq_L_subst2_rev, simp,simp)
apply(simp)
apply(rule foundation13[THEN iffD2,THEN StrongEq_L_subst2_rev, where y ="δ x"])
apply(simp_all add:def_scheme)
apply(simp add: OclValid_def)
by(auto simp:foundation13 StrongEq_def false_def true_def defined_def bot_fun_def null_fun_def def_body
split: if_split_asm)
lemma def_valid_then_def: "υ(f x) = (δ(f x))"
apply(rule ext, rename_tac "τ",subst foundation22[symmetric])
apply(case_tac "¬(τ ⊨ δ x)", simp add:defined_split, elim disjE)
apply(erule StrongEq_L_subst2_rev, simp,simp)
apply(erule StrongEq_L_subst2_rev, simp,simp)
apply simp
apply(simp_all add:def_scheme)
apply(simp add: OclValid_def valid_def, subst cp_StrongEq)
apply(subst (2) cp_defined, simp, simp add: cp_defined[symmetric])
by(auto simp:foundation13 StrongEq_def false_def true_def defined_def bot_fun_def null_fun_def def_body
split: if_split_asm)
end
subsection‹Property Profiles for Single›
locale profile_single =
fixes d:: "('𝔄,'a::null)val ⇒ '𝔄 Boolean"
assumes d_strict[simp,code_unfold]: "d invalid = false"
assumes d_cp0: "d X τ = d (λ _. X τ) τ"
assumes d_const[simp,code_unfold]: "const X ⟹ const (d X)"
subsection‹Property Profiles for Binary Operators›
definition "bin' f g d⇩x d⇩y X Y =
(f X Y = (λ τ. if (d⇩x X) τ = true τ ∧ (d⇩y Y) τ = true τ
then g X Y τ
else invalid τ ))"
definition "bin f g = bin' f (λX Y τ. g (X τ) (Y τ))"
lemmas [simp,code_unfold] = bin'_def bin_def
locale profile_bin_scheme =
fixes d⇩x:: "('𝔄,'a::null)val ⇒ '𝔄 Boolean"
fixes d⇩y:: "('𝔄,'b::null)val ⇒ '𝔄 Boolean"
fixes f::"('𝔄,'a::null)val ⇒ ('𝔄,'b::null)val ⇒ ('𝔄,'c::null)val"
fixes g
assumes d⇩x' : "profile_single d⇩x"
assumes d⇩y' : "profile_single d⇩y"
assumes d⇩x_d⇩y_homo[simp,code_unfold]: "cp (f X) ⟹
cp (λx. f x Y) ⟹
f X invalid = invalid ⟹
f invalid Y = invalid ⟹
(¬ (τ ⊨ d⇩x X) ∨ ¬ (τ ⊨ d⇩y Y)) ⟹
τ ⊨ (δ f X Y ≜ (d⇩x X and d⇩y Y))"
assumes def_scheme''[simplified]: "bin f g d⇩x d⇩y X Y"
assumes 1: "τ ⊨ d⇩x X ⟹ τ ⊨ d⇩y Y ⟹ τ ⊨ δ f X Y"
begin
interpretation d⇩x : profile_single d⇩x by (rule d⇩x')
interpretation d⇩y : profile_single d⇩y by (rule d⇩y')
lemma strict1[simp,code_unfold]: " f invalid y = invalid"
by(rule ext, simp add: def_scheme'' true_def false_def)
lemma strict2[simp,code_unfold]: " f x invalid = invalid"
by(rule ext, simp add: def_scheme'' true_def false_def)
lemma cp0 : "f X Y τ = f (λ _. X τ) (λ _. Y τ) τ"
by(simp add: def_scheme'' d⇩x.d_cp0[symmetric] d⇩y.d_cp0[symmetric] cp_defined[symmetric])
lemma cp[simp,code_unfold] : " cp P ⟹ cp Q ⟹ cp (λX. f (P X) (Q X))"
by(rule cpI2[of "f"], intro allI, rule cp0, simp_all)
lemma def_homo[simp,code_unfold]: "δ(f x y) = (d⇩x x and d⇩y y)"
apply(rule ext, rename_tac "τ",subst foundation22[symmetric])
apply(case_tac "¬(τ ⊨ d⇩x x)", simp)
apply(case_tac "¬(τ ⊨ d⇩y y)", simp)
apply(simp)
apply(rule foundation13[THEN iffD2,THEN StrongEq_L_subst2_rev, where y ="d⇩x x"])
apply(simp_all)
apply(rule foundation13[THEN iffD2,THEN StrongEq_L_subst2_rev, where y ="d⇩y y"])
apply(simp_all add: 1 foundation13)
done
lemma def_valid_then_def: "υ(f x y) = (δ(f x y))"
apply(rule ext, rename_tac "τ")
apply(simp_all add: valid_def defined_def def_scheme''
true_def false_def invalid_def
null_def null_fun_def null_option_def bot_fun_def)
by (metis "1" OclValid_def def_scheme'' foundation16 true_def)
lemma defined_args_valid: "(τ ⊨ δ (f x y)) = ((τ ⊨ d⇩x x) ∧ (τ ⊨ d⇩y y))"
by(simp add: foundation10')
lemma const[simp,code_unfold] :
assumes C1 :"const X" and C2 : "const Y"
shows "const(f X Y)"
proof -
have const_g : "const (λτ. g (X τ) (Y τ))"
by(insert C1 C2, auto simp:const_def, metis)
show ?thesis
by(simp_all add : def_scheme'' const_ss C1 C2 const_g)
qed
end
text‹
In our context, we will use Locales as ``Property Profiles'' for OCL operators;
if an operator @{term "f"} is of profile @{term "profile_bin_scheme defined f g"} we know
that it satisfies a number of properties like ‹strict1› or ‹strict2›
\ie{} @{term "f invalid y = invalid"} and @{term "f null y = invalid"}.
Since some of the more advanced Locales come with 10 - 15 theorems, property profiles
represent a major structuring mechanism for the OCL library.
›
locale profile_bin_scheme_defined =
fixes d⇩y:: "('𝔄,'b::null)val ⇒ '𝔄 Boolean"
fixes f::"('𝔄,'a::null)val ⇒ ('𝔄,'b::null)val ⇒ ('𝔄,'c::null)val"
fixes g
assumes d⇩y : "profile_single d⇩y"
assumes d⇩y_homo[simp,code_unfold]: "cp (f X) ⟹
f X invalid = invalid ⟹
¬ τ ⊨ d⇩y Y ⟹
τ ⊨ δ f X Y ≜ (δ X and d⇩y Y)"
assumes def_scheme'[simplified]: "bin f g defined d⇩y X Y"
assumes def_body': "⋀ x y τ. x≠bot ⟹ x≠null ⟹ (d⇩y y) τ = true τ ⟹ g x (y τ) ≠ bot ∧ g x (y τ) ≠ null "
begin
lemma strict3[simp,code_unfold]: " f null y = invalid"
by(rule ext, simp add: def_scheme' true_def false_def)
end
sublocale profile_bin_scheme_defined < profile_bin_scheme defined
proof -
interpret d⇩y : profile_single d⇩y by (rule d⇩y)
show "profile_bin_scheme defined d⇩y f g"
apply(unfold_locales)
apply(simp)+
apply(subst cp_defined, simp)
apply(rule const_defined, simp)
apply(simp add:defined_split, elim disjE)
apply(erule StrongEq_L_subst2_rev, simp, simp)+
apply(simp)
apply(simp add: def_scheme')
apply(simp add: defined_def OclValid_def false_def true_def
bot_fun_def null_fun_def def_scheme' split: if_split_asm, rule def_body')
by(simp add: true_def)+
qed
locale profile_bin⇩d_⇩d =
fixes f::"('𝔄,'a::null)val ⇒ ('𝔄,'b::null)val ⇒ ('𝔄,'c::null)val"
fixes g
assumes def_scheme[simplified]: "bin f g defined defined X Y"
assumes def_body: "⋀ x y. x≠bot ⟹ x≠null ⟹ y≠bot ⟹ y≠null ⟹
g x y ≠ bot ∧ g x y ≠ null "
begin
lemma strict4[simp,code_unfold]: " f x null = invalid"
by(rule ext, simp add: def_scheme true_def false_def)
end
sublocale profile_bin⇩d_⇩d < profile_bin_scheme_defined defined
apply(unfold_locales)
apply(simp)+
apply(subst cp_defined, simp)+
apply(rule const_defined, simp)+
apply(simp add:defined_split, elim disjE)
apply(erule StrongEq_L_subst2_rev, simp, simp)+
apply(simp add: def_scheme)
apply(simp add: defined_def OclValid_def false_def true_def bot_fun_def null_fun_def def_scheme)
apply(rule def_body, simp_all add: true_def false_def split:if_split_asm)
done
locale profile_bin⇩d_⇩v =
fixes f::"('𝔄,'a::null)val ⇒ ('𝔄,'b::null)val ⇒ ('𝔄,'c::null)val"
fixes g
assumes def_scheme[simplified]: "bin f g defined valid X Y"
assumes def_body: "⋀ x y. x≠bot ⟹ x≠null ⟹ y≠bot ⟹ g x y ≠ bot ∧ g x y ≠ null"
sublocale profile_bin⇩d_⇩v < profile_bin_scheme_defined valid
apply(unfold_locales)
apply(simp)
apply(subst cp_valid, simp)
apply(rule const_valid, simp)
apply(simp add:foundation18'')
apply(erule StrongEq_L_subst2_rev, simp, simp)
apply(simp add: def_scheme)
by (metis OclValid_def def_body foundation18')
locale profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v =
fixes f :: "('𝔄,'α::null)val ⇒ ('𝔄,'α::null)val ⇒ ('𝔄) Boolean"
assumes def_scheme[simplified]: "bin' f StrongEq valid valid X Y"
sublocale profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v < profile_bin_scheme valid valid f "λx y. ⌊⌊x = y⌋⌋"
apply(unfold_locales)
apply(simp)
apply(subst cp_valid, simp)
apply (simp add: const_valid)
apply (metis (hide_lams, mono_tags) OclValid_def def_scheme defined5 defined6 defined_and_I foundation1 foundation10' foundation16' foundation18 foundation21 foundation22 foundation9)
apply(simp add: def_scheme, subst StrongEq_def, simp)
by (metis OclValid_def def_scheme defined7 foundation16)
context profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v
begin
lemma idem[simp,code_unfold]: " f null null = true"
by(rule ext, simp add: def_scheme true_def false_def)
lemma defargs: "τ ⊨ f x y ⟹ (τ ⊨ υ x) ∧ (τ ⊨ υ y)"
by(simp add: def_scheme OclValid_def true_def invalid_def valid_def bot_option_def
split: bool.split_asm HOL.if_split_asm)
lemma defined_args_valid' : "δ (f x y) = (υ x and υ y)"
by(auto intro!: transform2_rev defined_and_I simp:foundation10 defined_args_valid)
lemma refl_ext[simp,code_unfold] : "(f x x) = (if (υ x) then true else invalid endif)"
by(rule ext, simp add: def_scheme OclIf_def)
lemma sym : "τ ⊨ (f x y) ⟹ τ ⊨ (f y x)"
apply(case_tac "τ ⊨ υ x")
apply(auto simp: def_scheme OclValid_def)
by(fold OclValid_def, erule StrongEq_L_sym)
lemma symmetric : "(f x y) = (f y x)"
by(rule ext, rename_tac τ, auto simp: def_scheme StrongEq_sym)
lemma trans : "τ ⊨ (f x y) ⟹ τ ⊨ (f y z) ⟹ τ ⊨ (f x z)"
apply(case_tac "τ ⊨ υ x")
apply(case_tac "τ ⊨ υ y")
apply(auto simp: def_scheme OclValid_def)
by(fold OclValid_def, auto elim: StrongEq_L_trans)
lemma StrictRefEq_vs_StrongEq: "τ ⊨(υ x) ⟹ τ ⊨(υ y) ⟹ (τ ⊨ ((f x y) ≜ (x ≜ y)))"
apply(simp add: def_scheme OclValid_def)
apply(subst cp_StrongEq[of _ "(x ≜ y)"])
by simp
end
locale profile_bin⇩v_⇩v =
fixes f :: "('𝔄,'α::null)val ⇒ ('𝔄,'β::null)val ⇒ ('𝔄,'γ::null)val"
fixes g
assumes def_scheme[simplified]: "bin f g valid valid X Y"
assumes def_body: "⋀ x y. x≠bot ⟹ y≠bot ⟹ g x y ≠ bot ∧ g x y ≠ null"
sublocale profile_bin⇩v_⇩v < profile_bin_scheme valid valid
apply(unfold_locales)
apply(simp, subst cp_valid, simp, rule const_valid, simp)+
apply (metis (hide_lams, mono_tags) OclValid_def def_scheme defined5 defined6 defined_and_I
foundation1 foundation10' foundation16' foundation18 foundation21 foundation22 foundation9)
apply(simp add: def_scheme)
apply(simp add: defined_def OclValid_def false_def true_def
bot_fun_def null_fun_def def_scheme split: if_split_asm, rule def_body)
by (metis OclValid_def foundation18' true_def)+
end
Theory UML_Boolean
theory UML_Boolean
imports "../UML_PropertyProfiles"
begin
subsection‹Fundamental Predicates on Basic Types: Strict (Referential) Equality›
text‹
Here is a first instance of a definition of strict value equality---for
the special case of the type @{typ "('𝔄)Boolean"}, it is just
the strict extension of the logical
equality:
›
overloading StrictRefEq ≡ "StrictRefEq :: [('𝔄)Boolean,('𝔄)Boolean] ⇒ ('𝔄)Boolean"
begin
definition StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n[code_unfold] :
"(x::('𝔄)Boolean) ≐ y ≡ λ τ. if (υ x) τ = true τ ∧ (υ y) τ = true τ
then (x ≜ y)τ
else invalid τ"
end
text‹which implies elementary properties like:›
lemma [simp,code_unfold] : "(true ≐ false) = false"
by(simp add:StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n)
lemma [simp,code_unfold] : "(false ≐ true) = false"
by(simp add:StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n)
lemma null_non_false [simp,code_unfold]:"(null ≐ false) = false"
apply(rule ext, simp add: StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n StrongEq_def false_def)
by (metis drop.simps cp_valid false_def is_none_code(2) Option.is_none_def valid4
bot_option_def null_fun_def null_option_def)
lemma null_non_true [simp,code_unfold]:"(null ≐ true) = false"
apply(rule ext, simp add: StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n StrongEq_def false_def)
by(simp add: true_def bot_option_def null_fun_def null_option_def)
lemma false_non_null [simp,code_unfold]:"(false ≐ null) = false"
apply(rule ext, simp add: StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n StrongEq_def false_def)
by(metis drop.simps cp_valid false_def is_none_code(2) Option.is_none_def valid4
bot_option_def null_fun_def null_option_def )
lemma true_non_null [simp,code_unfold]:"(true ≐ null) = false"
apply(rule ext, simp add: StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n StrongEq_def false_def)
by(simp add: true_def bot_option_def null_fun_def null_option_def)
text‹With respect to strictness properties and miscelleaneous side-calculi,
strict referential equality behaves on booleans as described in the
@{term "profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v"}:›
interpretation StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n : profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v "λ x y. (x::('𝔄)Boolean) ≐ y"
by unfold_locales (auto simp:StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n)
text‹In particular, it is strict, cp-preserving and const-preserving. In particular,
it generates the simplifier rules for terms like:›
lemma "(invalid ≐ false) = invalid" by(simp)
lemma "(invalid ≐ true) = invalid" by(simp)
lemma "(false ≐ invalid) = invalid" by(simp)
lemma "(true ≐ invalid) = invalid" by(simp)
lemma "((invalid::('𝔄)Boolean) ≐ invalid) = invalid" by(simp)
text‹Thus, the weak equality is \emph{not} reflexive.›
subsection‹Test Statements on Boolean Operations.›
text‹Here follows a list of code-examples, that explain the meanings
of the above definitions by compilation to code and execution to @{term "True"}.›
text‹Elementary computations on Boolean›
Assert "τ ⊨ υ(true)"
Assert "τ ⊨ δ(false)"
Assert "τ |≠ δ(null)"
Assert "τ |≠ δ(invalid)"
Assert "τ ⊨ υ((null::('𝔄)Boolean))"
Assert "τ |≠ υ(invalid)"
Assert "τ ⊨ (true and true)"
Assert "τ ⊨ (true and true ≜ true)"
Assert "τ ⊨ ((null or null) ≜ null)"
Assert "τ ⊨ ((null or null) ≐ null)"
Assert "τ ⊨ ((true ≜ false) ≜ false)"
Assert "τ ⊨ ((invalid ≜ false) ≜ false)"
Assert "τ ⊨ ((invalid ≐ false) ≜ invalid)"
Assert "τ ⊨ (true <> false)"
Assert "τ ⊨ (false <> true)"
end
Theory UML_Void
theory UML_Void
imports "../UML_PropertyProfiles"
begin
section‹Basic Type Void: Operations›
text ‹This \emph{minimal} OCL type contains only two elements:
@{term "invalid"} and @{term "null"}.
@{term "Void"} could initially be defined as @{typ "unit option option"},
however the cardinal of this type is more than two, so it would have the cost to consider
‹Some None› and ‹Some (Some ())› seemingly everywhere.›
subsection‹Fundamental Properties on Voids: Strict Equality›
subsubsection‹Definition›
instantiation Void⇩b⇩a⇩s⇩e :: bot
begin
definition bot_Void_def: "(bot_class.bot :: Void⇩b⇩a⇩s⇩e) ≡ Abs_Void⇩b⇩a⇩s⇩e None"
instance proof show "∃x:: Void⇩b⇩a⇩s⇩e. x ≠ bot"
apply(rule_tac x="Abs_Void⇩b⇩a⇩s⇩e ⌊None⌋" in exI)
apply(simp add:bot_Void_def, subst Abs_Void⇩b⇩a⇩s⇩e_inject)
apply(simp_all add: null_option_def bot_option_def)
done
qed
end
instantiation Void⇩b⇩a⇩s⇩e :: null
begin
definition null_Void_def: "(null::Void⇩b⇩a⇩s⇩e) ≡ Abs_Void⇩b⇩a⇩s⇩e ⌊ None ⌋"
instance proof show "(null:: Void⇩b⇩a⇩s⇩e) ≠ bot"
apply(simp add:null_Void_def bot_Void_def, subst Abs_Void⇩b⇩a⇩s⇩e_inject)
apply(simp_all add: null_option_def bot_option_def)
done
qed
end
text‹The last basic operation belonging to the fundamental infrastructure
of a value-type in OCL is the weak equality, which is defined similar
to the @{typ "('𝔄)Void"}-case as strict extension of the strong equality:›
overloading StrictRefEq ≡ "StrictRefEq :: [('𝔄)Void,('𝔄)Void] ⇒ ('𝔄)Boolean"
begin
definition StrictRefEq⇩V⇩o⇩i⇩d[code_unfold] :
"(x::('𝔄)Void) ≐ y ≡ λ τ. if (υ x) τ = true τ ∧ (υ y) τ = true τ
then (x ≜ y) τ
else invalid τ"
end
text‹Property proof in terms of @{term "profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v"}›
interpretation StrictRefEq⇩V⇩o⇩i⇩d : profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v "λ x y. (x::('𝔄)Void) ≐ y"
by unfold_locales (auto simp: StrictRefEq⇩V⇩o⇩i⇩d)
subsection‹Basic Void Constants›
subsection‹Validity and Definedness Properties›
lemma "δ(null::('𝔄)Void) = false" by simp
lemma "υ(null::('𝔄)Void) = true" by simp
lemma [simp,code_unfold]: "δ (λ_. Abs_Void⇩b⇩a⇩s⇩e None) = false"
apply(simp add:defined_def true_def
bot_fun_def bot_option_def)
apply(rule ext, simp split:, intro conjI impI)
by(simp add: bot_Void_def)
lemma [simp,code_unfold]: "υ (λ_. Abs_Void⇩b⇩a⇩s⇩e None) = false"
apply(simp add:valid_def true_def
bot_fun_def bot_option_def)
apply(rule ext, simp split:, intro conjI impI)
by(simp add: bot_Void_def)
lemma [simp,code_unfold]: "δ (λ_. Abs_Void⇩b⇩a⇩s⇩e ⌊None⌋) = false"
apply(simp add:defined_def true_def
bot_fun_def bot_option_def null_fun_def null_option_def)
apply(rule ext, simp split:, intro conjI impI)
by(simp add: null_Void_def)
lemma [simp,code_unfold]: "υ (λ_. Abs_Void⇩b⇩a⇩s⇩e ⌊None⌋) = true"
apply(simp add:valid_def true_def
bot_fun_def bot_option_def)
apply(rule ext, simp split:, intro conjI impI)
by(metis null_Void_def null_is_valid, simp add: true_def)
subsection‹Test Statements›
Assert "τ ⊨ ((null::('𝔄)Void) ≐ null)"
end
Theory UML_Integer
theory UML_Integer
imports "../UML_PropertyProfiles"
begin
section‹Basic Type Integer: Operations›
subsection‹Fundamental Predicates on Integers: Strict Equality \label{sec:integer-strict-eq}›
text‹The last basic operation belonging to the fundamental infrastructure
of a value-type in OCL is the weak equality, which is defined similar
to the @{typ "('𝔄)Boolean"}-case as strict extension of the strong equality:›
overloading StrictRefEq ≡ "StrictRefEq :: [('𝔄)Integer,('𝔄)Integer] ⇒ ('𝔄)Boolean"
begin
definition StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r[code_unfold] :
"(x::('𝔄)Integer) ≐ y ≡ λ τ. if (υ x) τ = true τ ∧ (υ y) τ = true τ
then (x ≜ y) τ
else invalid τ"
end
text‹Property proof in terms of @{term "profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v"}›
interpretation StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r : profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v "λ x y. (x::('𝔄)Integer) ≐ y"
by unfold_locales (auto simp: StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r)
subsection‹Basic Integer Constants›
text‹Although the remaining part of this library reasons about
integers abstractly, we provide here as example some convenient shortcuts.›
definition OclInt0 ::"('𝔄)Integer" ("𝟬") where "𝟬 = (λ _ . ⌊⌊0::int⌋⌋)"
definition OclInt1 ::"('𝔄)Integer" ("𝟭") where "𝟭 = (λ _ . ⌊⌊1::int⌋⌋)"
definition OclInt2 ::"('𝔄)Integer" ("𝟮") where "𝟮 = (λ _ . ⌊⌊2::int⌋⌋)"
text‹Etc.›
text_raw‹\isatagafp›
definition OclInt3 ::"('𝔄)Integer" ("𝟯") where "𝟯 = (λ _ . ⌊⌊3::int⌋⌋)"
definition OclInt4 ::"('𝔄)Integer" ("𝟰") where "𝟰 = (λ _ . ⌊⌊4::int⌋⌋)"
definition OclInt5 ::"('𝔄)Integer" ("𝟱") where "𝟱 = (λ _ . ⌊⌊5::int⌋⌋)"
definition OclInt6 ::"('𝔄)Integer" ("𝟲") where "𝟲 = (λ _ . ⌊⌊6::int⌋⌋)"
definition OclInt7 ::"('𝔄)Integer" ("𝟳") where "𝟳 = (λ _ . ⌊⌊7::int⌋⌋)"
definition OclInt8 ::"('𝔄)Integer" ("𝟴") where "𝟴 = (λ _ . ⌊⌊8::int⌋⌋)"
definition OclInt9 ::"('𝔄)Integer" ("𝟵") where "𝟵 = (λ _ . ⌊⌊9::int⌋⌋)"
definition OclInt10 ::"('𝔄)Integer" ("𝟭𝟬")where "𝟭𝟬 = (λ _ . ⌊⌊10::int⌋⌋)"
subsection‹Validity and Definedness Properties›
lemma "δ(null::('𝔄)Integer) = false" by simp
lemma "υ(null::('𝔄)Integer) = true" by simp
lemma [simp,code_unfold]: "δ (λ_. ⌊⌊n⌋⌋) = true"
by(simp add:defined_def true_def
bot_fun_def bot_option_def null_fun_def null_option_def)
lemma [simp,code_unfold]: "υ (λ_. ⌊⌊n⌋⌋) = true"
by(simp add:valid_def true_def
bot_fun_def bot_option_def)
lemma [simp,code_unfold]: "δ 𝟬 = true" by(simp add:OclInt0_def)
lemma [simp,code_unfold]: "υ 𝟬 = true" by(simp add:OclInt0_def)
lemma [simp,code_unfold]: "δ 𝟭 = true" by(simp add:OclInt1_def)
lemma [simp,code_unfold]: "υ 𝟭 = true" by(simp add:OclInt1_def)
lemma [simp,code_unfold]: "δ 𝟮 = true" by(simp add:OclInt2_def)
lemma [simp,code_unfold]: "υ 𝟮 = true" by(simp add:OclInt2_def)
lemma [simp,code_unfold]: "δ 𝟲 = true" by(simp add:OclInt6_def)
lemma [simp,code_unfold]: "υ 𝟲 = true" by(simp add:OclInt6_def)
lemma [simp,code_unfold]: "δ 𝟴 = true" by(simp add:OclInt8_def)
lemma [simp,code_unfold]: "υ 𝟴 = true" by(simp add:OclInt8_def)
lemma [simp,code_unfold]: "δ 𝟵 = true" by(simp add:OclInt9_def)
lemma [simp,code_unfold]: "υ 𝟵 = true" by(simp add:OclInt9_def)
text_raw‹\endisatagafp›
subsection‹Arithmetical Operations›
subsubsection‹Definition›
text‹Here is a common case of a built-in operation on built-in types.
Note that the arguments must be both defined (non-null, non-bot).›
text‹Note that we can not follow the lexis of the OCL Standard for Isabelle
technical reasons; these operators are heavily overloaded in the HOL library
that a further overloading would lead to heavy technical buzz in this
document.
›
definition OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r ::"('𝔄)Integer ⇒ ('𝔄)Integer ⇒ ('𝔄)Integer" (infix "+⇩i⇩n⇩t" 40)
where "x +⇩i⇩n⇩t y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊⌈⌈x τ⌉⌉ + ⌈⌈y τ⌉⌉⌋⌋
else invalid τ "
interpretation OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r : profile_bin⇩d_⇩d "(+⇩i⇩n⇩t)" "λ x y. ⌊⌊⌈⌈x⌉⌉ + ⌈⌈y⌉⌉⌋⌋"
by unfold_locales (auto simp:OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r_def bot_option_def null_option_def)
definition OclMinus⇩I⇩n⇩t⇩e⇩g⇩e⇩r ::"('𝔄)Integer ⇒ ('𝔄)Integer ⇒ ('𝔄)Integer" (infix "-⇩i⇩n⇩t" 41)
where "x -⇩i⇩n⇩t y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊⌈⌈x τ⌉⌉ - ⌈⌈y τ⌉⌉⌋⌋
else invalid τ "
interpretation OclMinus⇩I⇩n⇩t⇩e⇩g⇩e⇩r : profile_bin⇩d_⇩d "(-⇩i⇩n⇩t)" "λ x y. ⌊⌊⌈⌈x⌉⌉ - ⌈⌈y⌉⌉⌋⌋"
by unfold_locales (auto simp:OclMinus⇩I⇩n⇩t⇩e⇩g⇩e⇩r_def bot_option_def null_option_def)
definition OclMult⇩I⇩n⇩t⇩e⇩g⇩e⇩r ::"('𝔄)Integer ⇒ ('𝔄)Integer ⇒ ('𝔄)Integer" (infix "*⇩i⇩n⇩t" 45)
where "x *⇩i⇩n⇩t y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊⌈⌈x τ⌉⌉ * ⌈⌈y τ⌉⌉⌋⌋
else invalid τ"
interpretation OclMult⇩I⇩n⇩t⇩e⇩g⇩e⇩r : profile_bin⇩d_⇩d "OclMult⇩I⇩n⇩t⇩e⇩g⇩e⇩r" "λ x y. ⌊⌊⌈⌈x⌉⌉ * ⌈⌈y⌉⌉⌋⌋"
by unfold_locales (auto simp:OclMult⇩I⇩n⇩t⇩e⇩g⇩e⇩r_def bot_option_def null_option_def)
text‹Here is the special case of division, which is defined as invalid for division
by zero.›
definition OclDivision⇩I⇩n⇩t⇩e⇩g⇩e⇩r ::"('𝔄)Integer ⇒ ('𝔄)Integer ⇒ ('𝔄)Integer" (infix "div⇩i⇩n⇩t" 45)
where "x div⇩i⇩n⇩t y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then if y τ ≠ OclInt0 τ then ⌊⌊⌈⌈x τ⌉⌉ div ⌈⌈y τ⌉⌉⌋⌋ else invalid τ
else invalid τ "
definition OclModulus⇩I⇩n⇩t⇩e⇩g⇩e⇩r ::"('𝔄)Integer ⇒ ('𝔄)Integer ⇒ ('𝔄)Integer" (infix "mod⇩i⇩n⇩t" 45)
where "x mod⇩i⇩n⇩t y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then if y τ ≠ OclInt0 τ then ⌊⌊⌈⌈x τ⌉⌉ mod ⌈⌈y τ⌉⌉⌋⌋ else invalid τ
else invalid τ "
definition OclLess⇩I⇩n⇩t⇩e⇩g⇩e⇩r ::"('𝔄)Integer ⇒ ('𝔄)Integer ⇒ ('𝔄)Boolean" (infix "<⇩i⇩n⇩t" 35)
where "x <⇩i⇩n⇩t y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊⌈⌈x τ⌉⌉ < ⌈⌈y τ⌉⌉⌋⌋
else invalid τ "
interpretation OclLess⇩I⇩n⇩t⇩e⇩g⇩e⇩r : profile_bin⇩d_⇩d "(<⇩i⇩n⇩t)" "λ x y. ⌊⌊⌈⌈x⌉⌉ < ⌈⌈y⌉⌉⌋⌋"
by unfold_locales (auto simp:OclLess⇩I⇩n⇩t⇩e⇩g⇩e⇩r_def bot_option_def null_option_def)
definition OclLe⇩I⇩n⇩t⇩e⇩g⇩e⇩r ::"('𝔄)Integer ⇒ ('𝔄)Integer ⇒ ('𝔄)Boolean" (infix "≤⇩i⇩n⇩t" 35)
where "x ≤⇩i⇩n⇩t y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊⌈⌈x τ⌉⌉ ≤ ⌈⌈y τ⌉⌉⌋⌋
else invalid τ "
interpretation OclLe⇩I⇩n⇩t⇩e⇩g⇩e⇩r : profile_bin⇩d_⇩d "(≤⇩i⇩n⇩t)" "λ x y. ⌊⌊⌈⌈x⌉⌉ ≤ ⌈⌈y⌉⌉⌋⌋"
by unfold_locales (auto simp:OclLe⇩I⇩n⇩t⇩e⇩g⇩e⇩r_def bot_option_def null_option_def)
subsubsection‹Basic Properties›
lemma OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r_commute: "(X +⇩i⇩n⇩t Y) = (Y +⇩i⇩n⇩t X)"
by(rule ext,auto simp:true_def false_def OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r_def invalid_def
split: option.split option.split_asm
bool.split bool.split_asm)
subsubsection‹Execution with Invalid or Null or Zero as Argument›
lemma OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r_zero1[simp,code_unfold] :
"(x +⇩i⇩n⇩t 𝟬) = (if υ x and not (δ x) then invalid else x endif)"
proof (rule ext, rename_tac τ, case_tac "(υ x and not (δ x)) τ = true τ")
fix τ show "(υ x and not (δ x)) τ = true τ ⟹
(x +⇩i⇩n⇩t 𝟬) τ = (if υ x and not (δ x) then invalid else x endif) τ"
apply(subst OclIf_true', simp add: OclValid_def)
by (metis OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r_def OclNot_defargs OclValid_def foundation5 foundation9)
next fix τ
have A: "⋀τ. (τ ⊨ not (υ x and not (δ x))) = (x τ = invalid τ ∨ τ ⊨ δ x)"
by (metis OclNot_not OclOr_def defined5 defined6 defined_not_I foundation11 foundation18'
foundation6 foundation7 foundation9 invalid_def)
have B: "τ ⊨ δ x ⟹ ⌊⌊⌈⌈x τ⌉⌉⌋⌋ = x τ"
apply(cases "x τ", metis bot_option_def foundation16)
apply(rename_tac x', case_tac x', metis bot_option_def foundation16 null_option_def)
by(simp)
show "(x +⇩i⇩n⇩t 𝟬) τ = (if υ x and not (δ x) then invalid else x endif) τ"
when "τ ⊨ not (υ x and not (δ x))"
apply(insert that, subst OclIf_false', simp, simp add: A, auto simp: OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r_def OclInt0_def)
apply(simp add: foundation16'[simplified OclValid_def])
apply(simp add: B)
by(simp add: OclValid_def)
qed(metis OclValid_def defined5 defined6 defined_and_I defined_not_I foundation9)
lemma OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r_zero2[simp,code_unfold] :
"(𝟬 +⇩i⇩n⇩t x) = (if υ x and not (δ x) then invalid else x endif)"
by(subst OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r_commute, simp)
subsection‹Test Statements›
text‹Here follows a list of code-examples, that explain the meanings
of the above definitions by compilation to code and execution to @{term "True"}.›
Assert "τ ⊨ ( 𝟵 ≤⇩i⇩n⇩t 𝟭𝟬 )"
Assert "τ ⊨ (( 𝟰 +⇩i⇩n⇩t 𝟰 ) ≤⇩i⇩n⇩t 𝟭𝟬 )"
Assert "τ |≠ (( 𝟰 +⇩i⇩n⇩t ( 𝟰 +⇩i⇩n⇩t 𝟰 )) <⇩i⇩n⇩t 𝟭𝟬 )"
Assert "τ ⊨ not (υ (null +⇩i⇩n⇩t 𝟭)) "
Assert "τ ⊨ (((𝟵 *⇩i⇩n⇩t 𝟰) div⇩i⇩n⇩t 𝟭𝟬) ≤⇩i⇩n⇩t 𝟰) "
Assert "τ ⊨ not (δ (𝟭 div⇩i⇩n⇩t 𝟬)) "
Assert "τ ⊨ not (υ (𝟭 div⇩i⇩n⇩t 𝟬)) "
lemma integer_non_null [simp]: "((λ_. ⌊⌊n⌋⌋) ≐ (null::('𝔄)Integer)) = false"
by(rule ext,auto simp: StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r valid_def
bot_fun_def bot_option_def null_fun_def null_option_def StrongEq_def)
lemma null_non_integer [simp]: "((null::('𝔄)Integer) ≐ (λ_. ⌊⌊n⌋⌋)) = false"
by(rule ext,auto simp: StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r valid_def
bot_fun_def bot_option_def null_fun_def null_option_def StrongEq_def)
lemma OclInt0_non_null [simp,code_unfold]: "(𝟬 ≐ null) = false" by(simp add: OclInt0_def)
lemma null_non_OclInt0 [simp,code_unfold]: "(null ≐ 𝟬) = false" by(simp add: OclInt0_def)
lemma OclInt1_non_null [simp,code_unfold]: "(𝟭 ≐ null) = false" by(simp add: OclInt1_def)
lemma null_non_OclInt1 [simp,code_unfold]: "(null ≐ 𝟭) = false" by(simp add: OclInt1_def)
lemma OclInt2_non_null [simp,code_unfold]: "(𝟮 ≐ null) = false" by(simp add: OclInt2_def)
lemma null_non_OclInt2 [simp,code_unfold]: "(null ≐ 𝟮) = false" by(simp add: OclInt2_def)
lemma OclInt6_non_null [simp,code_unfold]: "(𝟲 ≐ null) = false" by(simp add: OclInt6_def)
lemma null_non_OclInt6 [simp,code_unfold]: "(null ≐ 𝟲) = false" by(simp add: OclInt6_def)
lemma OclInt8_non_null [simp,code_unfold]: "(𝟴 ≐ null) = false" by(simp add: OclInt8_def)
lemma null_non_OclInt8 [simp,code_unfold]: "(null ≐ 𝟴) = false" by(simp add: OclInt8_def)
lemma OclInt9_non_null [simp,code_unfold]: "(𝟵 ≐ null) = false" by(simp add: OclInt9_def)
lemma null_non_OclInt9 [simp,code_unfold]: "(null ≐ 𝟵) = false" by(simp add: OclInt9_def)
text‹Here follows a list of code-examples, that explain the meanings
of the above definitions by compilation to code and execution to @{term "True"}.›
text‹Elementary computations on Integer›
Assert "τ ⊨ ((𝟬 <⇩i⇩n⇩t 𝟮) and (𝟬 <⇩i⇩n⇩t 𝟭))"
Assert "τ ⊨ 𝟭 <> 𝟮"
Assert "τ ⊨ 𝟮 <> 𝟭"
Assert "τ ⊨ 𝟮 ≐ 𝟮"
Assert "τ ⊨ υ 𝟰"
Assert "τ ⊨ δ 𝟰"
Assert "τ ⊨ υ (null::('𝔄)Integer)"
Assert "τ ⊨ (invalid ≜ invalid)"
Assert "τ ⊨ (null ≜ null)"
Assert "τ ⊨ (𝟰 ≜ 𝟰)"
Assert "τ |≠ (𝟵 ≜ 𝟭𝟬)"
Assert "τ |≠ (invalid ≜ 𝟭𝟬)"
Assert "τ |≠ (null ≜ 𝟭𝟬)"
Assert "τ |≠ (invalid ≐ (invalid::('𝔄)Integer))"
Assert "τ |≠ υ (invalid ≐ (invalid::('𝔄)Integer))"
Assert "τ |≠ (invalid <> (invalid::('𝔄)Integer))"
Assert "τ |≠ υ (invalid <> (invalid::('𝔄)Integer))"
Assert "τ ⊨ (null ≐ (null::('𝔄)Integer) )"
Assert "τ ⊨ (null ≐ (null::('𝔄)Integer) )"
Assert "τ ⊨ (𝟰 ≐ 𝟰)"
Assert "τ |≠ (𝟰 <> 𝟰)"
Assert "τ |≠ (𝟰 ≐ 𝟭𝟬)"
Assert "τ ⊨ (𝟰 <> 𝟭𝟬)"
Assert "τ |≠ (𝟬 <⇩i⇩n⇩t null)"
Assert "τ |≠ (δ (𝟬 <⇩i⇩n⇩t null))"
end
Theory UML_Real
theory UML_Real
imports "../UML_PropertyProfiles"
begin
section‹Basic Type Real: Operations›
subsection‹Fundamental Predicates on Reals: Strict Equality \label{sec:real-strict-eq}›
text‹The last basic operation belonging to the fundamental infrastructure
of a value-type in OCL is the weak equality, which is defined similar
to the @{typ "('𝔄)Boolean"}-case as strict extension of the strong equality:›
overloading StrictRefEq ≡ "StrictRefEq :: [('𝔄)Real,('𝔄)Real] ⇒ ('𝔄)Boolean"
begin
definition StrictRefEq⇩R⇩e⇩a⇩l [code_unfold] :
"(x::('𝔄)Real) ≐ y ≡ λ τ. if (υ x) τ = true τ ∧ (υ y) τ = true τ
then (x ≜ y) τ
else invalid τ"
end
text‹Property proof in terms of @{term "profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v"}›
interpretation StrictRefEq⇩R⇩e⇩a⇩l : profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v "λ x y. (x::('𝔄)Real) ≐ y"
by unfold_locales (auto simp: StrictRefEq⇩R⇩e⇩a⇩l)
subsection‹Basic Real Constants›
text‹Although the remaining part of this library reasons about
reals abstractly, we provide here as example some convenient shortcuts.›
definition OclReal0 ::"('𝔄)Real" ("𝟬.𝟬") where "𝟬.𝟬 = (λ _ . ⌊⌊0::real⌋⌋)"
definition OclReal1 ::"('𝔄)Real" ("𝟭.𝟬") where "𝟭.𝟬 = (λ _ . ⌊⌊1::real⌋⌋)"
definition OclReal2 ::"('𝔄)Real" ("𝟮.𝟬") where "𝟮.𝟬 = (λ _ . ⌊⌊2::real⌋⌋)"
text‹Etc.›
text_raw‹\isatagafp›
definition OclReal3 ::"('𝔄)Real" ("𝟯.𝟬") where "𝟯.𝟬 = (λ _ . ⌊⌊3::real⌋⌋)"
definition OclReal4 ::"('𝔄)Real" ("𝟰.𝟬") where "𝟰.𝟬 = (λ _ . ⌊⌊4::real⌋⌋)"
definition OclReal5 ::"('𝔄)Real" ("𝟱.𝟬") where "𝟱.𝟬 = (λ _ . ⌊⌊5::real⌋⌋)"
definition OclReal6 ::"('𝔄)Real" ("𝟲.𝟬") where "𝟲.𝟬 = (λ _ . ⌊⌊6::real⌋⌋)"
definition OclReal7 ::"('𝔄)Real" ("𝟳.𝟬") where "𝟳.𝟬 = (λ _ . ⌊⌊7::real⌋⌋)"
definition OclReal8 ::"('𝔄)Real" ("𝟴.𝟬") where "𝟴.𝟬 = (λ _ . ⌊⌊8::real⌋⌋)"
definition OclReal9 ::"('𝔄)Real" ("𝟵.𝟬") where "𝟵.𝟬 = (λ _ . ⌊⌊9::real⌋⌋)"
definition OclReal10 ::"('𝔄)Real" ("𝟭𝟬.𝟬") where "𝟭𝟬.𝟬 = (λ _ . ⌊⌊10::real⌋⌋)"
definition OclRealpi ::"('𝔄)Real" ("π") where "π = (λ _ . ⌊⌊pi⌋⌋)"
subsection‹Validity and Definedness Properties›
lemma "δ(null::('𝔄)Real) = false" by simp
lemma "υ(null::('𝔄)Real) = true" by simp
lemma [simp,code_unfold]: "δ (λ_. ⌊⌊n⌋⌋) = true"
by(simp add:defined_def true_def
bot_fun_def bot_option_def null_fun_def null_option_def)
lemma [simp,code_unfold]: "υ (λ_. ⌊⌊n⌋⌋) = true"
by(simp add:valid_def true_def
bot_fun_def bot_option_def)
lemma [simp,code_unfold]: "δ 𝟬.𝟬 = true" by(simp add:OclReal0_def)
lemma [simp,code_unfold]: "υ 𝟬.𝟬 = true" by(simp add:OclReal0_def)
lemma [simp,code_unfold]: "δ 𝟭.𝟬 = true" by(simp add:OclReal1_def)
lemma [simp,code_unfold]: "υ 𝟭.𝟬 = true" by(simp add:OclReal1_def)
lemma [simp,code_unfold]: "δ 𝟮.𝟬 = true" by(simp add:OclReal2_def)
lemma [simp,code_unfold]: "υ 𝟮.𝟬 = true" by(simp add:OclReal2_def)
lemma [simp,code_unfold]: "δ 𝟲.𝟬 = true" by(simp add:OclReal6_def)
lemma [simp,code_unfold]: "υ 𝟲.𝟬 = true" by(simp add:OclReal6_def)
lemma [simp,code_unfold]: "δ 𝟴.𝟬 = true" by(simp add:OclReal8_def)
lemma [simp,code_unfold]: "υ 𝟴.𝟬 = true" by(simp add:OclReal8_def)
lemma [simp,code_unfold]: "δ 𝟵.𝟬 = true" by(simp add:OclReal9_def)
lemma [simp,code_unfold]: "υ 𝟵.𝟬 = true" by(simp add:OclReal9_def)
text_raw‹\endisatagafp›
subsection‹Arithmetical Operations›
subsubsection‹Definition›
text‹Here is a common case of a built-in operation on built-in types.
Note that the arguments must be both defined (non-null, non-bot).›
text‹Note that we can not follow the lexis of the OCL Standard for Isabelle
technical reasons; these operators are heavily overloaded in the HOL library
that a further overloading would lead to heavy technical buzz in this
document.
›
definition OclAdd⇩R⇩e⇩a⇩l ::"('𝔄)Real ⇒ ('𝔄)Real ⇒ ('𝔄)Real" (infix "+⇩r⇩e⇩a⇩l" 40)
where "x +⇩r⇩e⇩a⇩l y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊⌈⌈x τ⌉⌉ + ⌈⌈y τ⌉⌉⌋⌋
else invalid τ "
interpretation OclAdd⇩R⇩e⇩a⇩l : profile_bin⇩d_⇩d "(+⇩r⇩e⇩a⇩l)" "λ x y. ⌊⌊⌈⌈x⌉⌉ + ⌈⌈y⌉⌉⌋⌋"
by unfold_locales (auto simp:OclAdd⇩R⇩e⇩a⇩l_def bot_option_def null_option_def)
definition OclMinus⇩R⇩e⇩a⇩l ::"('𝔄)Real ⇒ ('𝔄)Real ⇒ ('𝔄)Real" (infix "-⇩r⇩e⇩a⇩l" 41)
where "x -⇩r⇩e⇩a⇩l y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊⌈⌈x τ⌉⌉ - ⌈⌈y τ⌉⌉⌋⌋
else invalid τ "
interpretation OclMinus⇩R⇩e⇩a⇩l : profile_bin⇩d_⇩d "(-⇩r⇩e⇩a⇩l)" "λ x y. ⌊⌊⌈⌈x⌉⌉ - ⌈⌈y⌉⌉⌋⌋"
by unfold_locales (auto simp:OclMinus⇩R⇩e⇩a⇩l_def bot_option_def null_option_def)
definition OclMult⇩R⇩e⇩a⇩l ::"('𝔄)Real ⇒ ('𝔄)Real ⇒ ('𝔄)Real" (infix "*⇩r⇩e⇩a⇩l" 45)
where "x *⇩r⇩e⇩a⇩l y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊⌈⌈x τ⌉⌉ * ⌈⌈y τ⌉⌉⌋⌋
else invalid τ"
interpretation OclMult⇩R⇩e⇩a⇩l : profile_bin⇩d_⇩d "OclMult⇩R⇩e⇩a⇩l" "λ x y. ⌊⌊⌈⌈x⌉⌉ * ⌈⌈y⌉⌉⌋⌋"
by unfold_locales (auto simp:OclMult⇩R⇩e⇩a⇩l_def bot_option_def null_option_def)
text‹Here is the special case of division, which is defined as invalid for division
by zero.›
definition OclDivision⇩R⇩e⇩a⇩l ::"('𝔄)Real ⇒ ('𝔄)Real ⇒ ('𝔄)Real" (infix "div⇩r⇩e⇩a⇩l" 45)
where "x div⇩r⇩e⇩a⇩l y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then if y τ ≠ OclReal0 τ then ⌊⌊⌈⌈x τ⌉⌉ / ⌈⌈y τ⌉⌉⌋⌋ else invalid τ
else invalid τ "
definition "mod_float a b = a - real_of_int (floor (a / b)) * b"
definition OclModulus⇩R⇩e⇩a⇩l ::"('𝔄)Real ⇒ ('𝔄)Real ⇒ ('𝔄)Real" (infix "mod⇩r⇩e⇩a⇩l" 45)
where "x mod⇩r⇩e⇩a⇩l y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then if y τ ≠ OclReal0 τ then ⌊⌊mod_float ⌈⌈x τ⌉⌉ ⌈⌈y τ⌉⌉⌋⌋ else invalid τ
else invalid τ "
definition OclLess⇩R⇩e⇩a⇩l ::"('𝔄)Real ⇒ ('𝔄)Real ⇒ ('𝔄)Boolean" (infix "<⇩r⇩e⇩a⇩l" 35)
where "x <⇩r⇩e⇩a⇩l y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊⌈⌈x τ⌉⌉ < ⌈⌈y τ⌉⌉⌋⌋
else invalid τ "
interpretation OclLess⇩R⇩e⇩a⇩l : profile_bin⇩d_⇩d "(<⇩r⇩e⇩a⇩l)" "λ x y. ⌊⌊⌈⌈x⌉⌉ < ⌈⌈y⌉⌉⌋⌋"
by unfold_locales (auto simp:OclLess⇩R⇩e⇩a⇩l_def bot_option_def null_option_def)
definition OclLe⇩R⇩e⇩a⇩l ::"('𝔄)Real ⇒ ('𝔄)Real ⇒ ('𝔄)Boolean" (infix "≤⇩r⇩e⇩a⇩l" 35)
where "x ≤⇩r⇩e⇩a⇩l y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊⌈⌈x τ⌉⌉ ≤ ⌈⌈y τ⌉⌉⌋⌋
else invalid τ "
interpretation OclLe⇩R⇩e⇩a⇩l : profile_bin⇩d_⇩d "(≤⇩r⇩e⇩a⇩l)" "λ x y. ⌊⌊⌈⌈x⌉⌉ ≤ ⌈⌈y⌉⌉⌋⌋"
by unfold_locales (auto simp:OclLe⇩R⇩e⇩a⇩l_def bot_option_def null_option_def)
subsubsection‹Basic Properties›
lemma OclAdd⇩R⇩e⇩a⇩l_commute: "(X +⇩r⇩e⇩a⇩l Y) = (Y +⇩r⇩e⇩a⇩l X)"
by(rule ext,auto simp:true_def false_def OclAdd⇩R⇩e⇩a⇩l_def invalid_def
split: option.split option.split_asm
bool.split bool.split_asm)
subsubsection‹Execution with Invalid or Null or Zero as Argument›
lemma OclAdd⇩R⇩e⇩a⇩l_zero1[simp,code_unfold] :
"(x +⇩r⇩e⇩a⇩l 𝟬.𝟬) = (if υ x and not (δ x) then invalid else x endif)"
proof (rule ext, rename_tac τ, case_tac "(υ x and not (δ x)) τ = true τ")
fix τ show "(υ x and not (δ x)) τ = true τ ⟹
(x +⇩r⇩e⇩a⇩l 𝟬.𝟬) τ = (if υ x and not (δ x) then invalid else x endif) τ"
apply(subst OclIf_true', simp add: OclValid_def)
by (metis OclAdd⇩R⇩e⇩a⇩l_def OclNot_defargs OclValid_def foundation5 foundation9)
next fix τ
have A: "⋀τ. (τ ⊨ not (υ x and not (δ x))) = (x τ = invalid τ ∨ τ ⊨ δ x)"
by (metis OclNot_not OclOr_def defined5 defined6 defined_not_I foundation11 foundation18'
foundation6 foundation7 foundation9 invalid_def)
have B: "τ ⊨ δ x ⟹ ⌊⌊⌈⌈x τ⌉⌉⌋⌋ = x τ"
apply(cases "x τ", metis bot_option_def foundation16)
apply(rename_tac x', case_tac x', metis bot_option_def foundation16 null_option_def)
by(simp)
show "(x +⇩r⇩e⇩a⇩l 𝟬.𝟬) τ = (if υ x and not (δ x) then invalid else x endif) τ"
when "τ ⊨ not (υ x and not (δ x))"
apply(insert that, subst OclIf_false', simp, simp add: A, auto simp: OclAdd⇩R⇩e⇩a⇩l_def OclReal0_def)
apply(simp add: foundation16'[simplified OclValid_def])
apply(simp add: B)
by(simp add: OclValid_def)
qed(metis OclValid_def defined5 defined6 defined_and_I defined_not_I foundation9)
lemma OclAdd⇩R⇩e⇩a⇩l_zero2[simp,code_unfold] :
"(𝟬.𝟬 +⇩r⇩e⇩a⇩l x) = (if υ x and not (δ x) then invalid else x endif)"
by(subst OclAdd⇩R⇩e⇩a⇩l_commute, simp)
subsection‹Test Statements›
text‹Here follows a list of code-examples, that explain the meanings
of the above definitions by compilation to code and execution to @{term "True"}.›
Assert "τ ⊨ ( 𝟵.𝟬 ≤⇩r⇩e⇩a⇩l 𝟭𝟬.𝟬 )"
Assert "τ ⊨ (( 𝟰.𝟬 +⇩r⇩e⇩a⇩l 𝟰.𝟬 ) ≤⇩r⇩e⇩a⇩l 𝟭𝟬.𝟬 )"
Assert "τ |≠ (( 𝟰.𝟬 +⇩r⇩e⇩a⇩l ( 𝟰.𝟬 +⇩r⇩e⇩a⇩l 𝟰.𝟬 )) <⇩r⇩e⇩a⇩l 𝟭𝟬.𝟬 )"
Assert "τ ⊨ not (υ (null +⇩r⇩e⇩a⇩l 𝟭.𝟬)) "
Assert "τ ⊨ (((𝟵.𝟬 *⇩r⇩e⇩a⇩l 𝟰.𝟬) div⇩r⇩e⇩a⇩l 𝟭𝟬.𝟬) ≤⇩r⇩e⇩a⇩l 𝟰.𝟬) "
Assert "τ ⊨ not (δ (𝟭.𝟬 div⇩r⇩e⇩a⇩l 𝟬.𝟬)) "
Assert "τ ⊨ not (υ (𝟭.𝟬 div⇩r⇩e⇩a⇩l 𝟬.𝟬)) "
lemma real_non_null [simp]: "((λ_. ⌊⌊n⌋⌋) ≐ (null::('𝔄)Real)) = false"
by(rule ext,auto simp: StrictRefEq⇩R⇩e⇩a⇩l valid_def
bot_fun_def bot_option_def null_fun_def null_option_def StrongEq_def)
lemma null_non_real [simp]: "((null::('𝔄)Real) ≐ (λ_. ⌊⌊n⌋⌋)) = false"
by(rule ext,auto simp: StrictRefEq⇩R⇩e⇩a⇩l valid_def
bot_fun_def bot_option_def null_fun_def null_option_def StrongEq_def)
lemma OclReal0_non_null [simp,code_unfold]: "(𝟬.𝟬 ≐ null) = false" by(simp add: OclReal0_def)
lemma null_non_OclReal0 [simp,code_unfold]: "(null ≐ 𝟬.𝟬) = false" by(simp add: OclReal0_def)
lemma OclReal1_non_null [simp,code_unfold]: "(𝟭.𝟬 ≐ null) = false" by(simp add: OclReal1_def)
lemma null_non_OclReal1 [simp,code_unfold]: "(null ≐ 𝟭.𝟬) = false" by(simp add: OclReal1_def)
lemma OclReal2_non_null [simp,code_unfold]: "(𝟮.𝟬 ≐ null) = false" by(simp add: OclReal2_def)
lemma null_non_OclReal2 [simp,code_unfold]: "(null ≐ 𝟮.𝟬) = false" by(simp add: OclReal2_def)
lemma OclReal6_non_null [simp,code_unfold]: "(𝟲.𝟬 ≐ null) = false" by(simp add: OclReal6_def)
lemma null_non_OclReal6 [simp,code_unfold]: "(null ≐ 𝟲.𝟬) = false" by(simp add: OclReal6_def)
lemma OclReal8_non_null [simp,code_unfold]: "(𝟴.𝟬 ≐ null) = false" by(simp add: OclReal8_def)
lemma null_non_OclReal8 [simp,code_unfold]: "(null ≐ 𝟴.𝟬) = false" by(simp add: OclReal8_def)
lemma OclReal9_non_null [simp,code_unfold]: "(𝟵.𝟬 ≐ null) = false" by(simp add: OclReal9_def)
lemma null_non_OclReal9 [simp,code_unfold]: "(null ≐ 𝟵.𝟬) = false" by(simp add: OclReal9_def)
text‹Here follows a list of code-examples, that explain the meanings
of the above definitions by compilation to code and execution to @{term "True"}.›
text‹Elementary computations on Real›
Assert "τ ⊨ 𝟭.𝟬 <> 𝟮.𝟬"
Assert "τ ⊨ 𝟮.𝟬 <> 𝟭.𝟬"
Assert "τ ⊨ 𝟮.𝟬 ≐ 𝟮.𝟬"
Assert "τ ⊨ υ 𝟰.𝟬"
Assert "τ ⊨ δ 𝟰.𝟬"
Assert "τ ⊨ υ (null::('𝔄)Real)"
Assert "τ ⊨ (invalid ≜ invalid)"
Assert "τ ⊨ (null ≜ null)"
Assert "τ ⊨ (𝟰.𝟬 ≜ 𝟰.𝟬)"
Assert "τ |≠ (𝟵.𝟬 ≜ 𝟭𝟬.𝟬)"
Assert "τ |≠ (invalid ≜ 𝟭𝟬.𝟬)"
Assert "τ |≠ (null ≜ 𝟭𝟬.𝟬)"
Assert "τ |≠ (invalid ≐ (invalid::('𝔄)Real))"
Assert "τ |≠ υ (invalid ≐ (invalid::('𝔄)Real))"
Assert "τ |≠ (invalid <> (invalid::('𝔄)Real))"
Assert "τ |≠ υ (invalid <> (invalid::('𝔄)Real))"
Assert "τ ⊨ (null ≐ (null::('𝔄)Real) )"
Assert "τ ⊨ (null ≐ (null::('𝔄)Real) )"
Assert "τ ⊨ (𝟰.𝟬 ≐ 𝟰.𝟬)"
Assert "τ |≠ (𝟰.𝟬 <> 𝟰.𝟬)"
Assert "τ |≠ (𝟰.𝟬 ≐ 𝟭𝟬.𝟬)"
Assert "τ ⊨ (𝟰.𝟬 <> 𝟭𝟬.𝟬)"
Assert "τ |≠ (𝟬.𝟬 <⇩r⇩e⇩a⇩l null)"
Assert "τ |≠ (δ (𝟬.𝟬 <⇩r⇩e⇩a⇩l null))"
end
Theory UML_String
theory UML_String
imports "../UML_PropertyProfiles"
begin
section‹Basic Type String: Operations›
subsection‹Fundamental Properties on Strings: Strict Equality \label{sec:string-strict-eq}›
text‹The last basic operation belonging to the fundamental infrastructure
of a value-type in OCL is the weak equality, which is defined similar
to the @{typ "('𝔄)Boolean"}-case as strict extension of the strong equality:›
overloading StrictRefEq ≡ "StrictRefEq :: [('𝔄)String,('𝔄)String] ⇒ ('𝔄)Boolean"
begin
definition StrictRefEq⇩S⇩t⇩r⇩i⇩n⇩g[code_unfold] :
"(x::('𝔄)String) ≐ y ≡ λ τ. if (υ x) τ = true τ ∧ (υ y) τ = true τ
then (x ≜ y) τ
else invalid τ"
end
text‹Property proof in terms of @{term "profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v"}›
interpretation StrictRefEq⇩S⇩t⇩r⇩i⇩n⇩g : profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v "λ x y. (x::('𝔄)String) ≐ y"
by unfold_locales (auto simp: StrictRefEq⇩S⇩t⇩r⇩i⇩n⇩g)
subsection‹Basic String Constants›
text‹Although the remaining part of this library reasons about
integers abstractly, we provide here as example some convenient shortcuts.›
definition OclStringa ::"('𝔄)String" ("𝖺") where "𝖺 = (λ _ . ⌊⌊''a''⌋⌋)"
definition OclStringb ::"('𝔄)String" ("𝖻") where "𝖻 = (λ _ . ⌊⌊''b''⌋⌋)"
definition OclStringc ::"('𝔄)String" ("𝖼") where "𝖼 = (λ _ . ⌊⌊''c''⌋⌋)"
text‹Etc.›
text_raw‹\isatagafp›
subsection‹Validity and Definedness Properties›
lemma "δ(null::('𝔄)String) = false" by simp
lemma "υ(null::('𝔄)String) = true" by simp
lemma [simp,code_unfold]: "δ (λ_. ⌊⌊n⌋⌋) = true"
by(simp add:defined_def true_def
bot_fun_def bot_option_def null_fun_def null_option_def)
lemma [simp,code_unfold]: "υ (λ_. ⌊⌊n⌋⌋) = true"
by(simp add:valid_def true_def
bot_fun_def bot_option_def)
lemma [simp,code_unfold]: "δ 𝖺 = true" by(simp add:OclStringa_def)
lemma [simp,code_unfold]: "υ 𝖺 = true" by(simp add:OclStringa_def)
text_raw‹\endisatagafp›
subsection‹String Operations›
subsubsection‹Definition›
text‹Here is a common case of a built-in operation on built-in types.
Note that the arguments must be both defined (non-null, non-bot).›
text‹Note that we can not follow the lexis of the OCL Standard for Isabelle
technical reasons; these operators are heavily overloaded in the HOL library
that a further overloading would lead to heavy technical buzz in this
document.
›
definition OclAdd⇩S⇩t⇩r⇩i⇩n⇩g ::"('𝔄)String ⇒ ('𝔄)String ⇒ ('𝔄)String" (infix "+⇩s⇩t⇩r⇩i⇩n⇩g" 40)
where "x +⇩s⇩t⇩r⇩i⇩n⇩g y ≡ λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊concat [⌈⌈x τ⌉⌉, ⌈⌈y τ⌉⌉]⌋⌋
else invalid τ "
interpretation OclAdd⇩S⇩t⇩r⇩i⇩n⇩g : profile_bin⇩d_⇩d "(+⇩s⇩t⇩r⇩i⇩n⇩g)" "λ x y. ⌊⌊concat [⌈⌈x⌉⌉, ⌈⌈y⌉⌉]⌋⌋"
by unfold_locales (auto simp:OclAdd⇩S⇩t⇩r⇩i⇩n⇩g_def bot_option_def null_option_def)
subsubsection‹Basic Properties›
lemma OclAdd⇩S⇩t⇩r⇩i⇩n⇩g_not_commute: "∃X Y. (X +⇩s⇩t⇩r⇩i⇩n⇩g Y) ≠ (Y +⇩s⇩t⇩r⇩i⇩n⇩g X)"
apply(rule_tac x = "λ_. ⌊⌊''b''⌋⌋" in exI)
apply(rule_tac x = "λ_. ⌊⌊''a''⌋⌋" in exI)
apply(simp_all add:OclAdd⇩S⇩t⇩r⇩i⇩n⇩g_def)
by(auto, drule fun_cong, auto)
subsection‹Test Statements›
text‹Here follows a list of code-examples, that explain the meanings
of the above definitions by compilation to code and execution to @{term "True"}.›
text‹Here follows a list of code-examples, that explain the meanings
of the above definitions by compilation to code and execution to @{term "True"}.›
text‹Elementary computations on String›
Assert "τ ⊨ 𝖺 <> 𝖻"
Assert "τ ⊨ 𝖻 <> 𝖺"
Assert "τ ⊨ 𝖻 ≐ 𝖻"
Assert "τ ⊨ υ 𝖺"
Assert "τ ⊨ δ 𝖺"
Assert "τ ⊨ υ (null::('𝔄)String)"
Assert "τ ⊨ (invalid ≜ invalid)"
Assert "τ ⊨ (null ≜ null)"
Assert "τ ⊨ (𝖺 ≜ 𝖺)"
Assert "τ |≠ (𝖺 ≜ 𝖻)"
Assert "τ |≠ (invalid ≜ 𝖻)"
Assert "τ |≠ (null ≜ 𝖻)"
Assert "τ |≠ (invalid ≐ (invalid::('𝔄)String))"
Assert "τ |≠ υ (invalid ≐ (invalid::('𝔄)String))"
Assert "τ |≠ (invalid <> (invalid::('𝔄)String))"
Assert "τ |≠ υ (invalid <> (invalid::('𝔄)String))"
Assert "τ ⊨ (null ≐ (null::('𝔄)String) )"
Assert "τ ⊨ (null ≐ (null::('𝔄)String) )"
Assert "τ ⊨ (𝖻 ≐ 𝖻)"
Assert "τ |≠ (𝖻 <> 𝖻)"
Assert "τ |≠ (𝖻 ≐ 𝖼)"
Assert "τ ⊨ (𝖻 <> 𝖼)"
end
Theory UML_Pair
theory UML_Pair
imports "../UML_PropertyProfiles"
begin
section‹Collection Type Pairs: Operations \label{sec:collection_pairs}›
text‹The OCL standard provides the concept of \emph{Tuples}, \ie{} a family of record-types
with projection functions. In FeatherWeight OCL, only the theory of a special case is
developped, namely the type of Pairs, which is, however, sufficient for all applications
since it can be used to mimick all tuples. In particular, it can be used to express operations
with multiple arguments, roles of n-ary associations, ...›
subsection‹Semantic Properties of the Type Constructor›
lemma A[simp]:"Rep_Pair⇩b⇩a⇩s⇩e x ≠ None ⟹ Rep_Pair⇩b⇩a⇩s⇩e x ≠ null ⟹ (fst ⌈⌈Rep_Pair⇩b⇩a⇩s⇩e x⌉⌉) ≠ bot"
by(insert Rep_Pair⇩b⇩a⇩s⇩e[of x],auto simp:null_option_def bot_option_def)
lemma A'[simp]:" x ≠ bot ⟹ x ≠ null ⟹ (fst ⌈⌈Rep_Pair⇩b⇩a⇩s⇩e x⌉⌉) ≠ bot"
apply(insert Rep_Pair⇩b⇩a⇩s⇩e[of x], simp add: bot_Pair⇩b⇩a⇩s⇩e_def null_Pair⇩b⇩a⇩s⇩e_def)
apply(auto simp:null_option_def bot_option_def)
apply(erule contrapos_np[of "x = Abs_Pair⇩b⇩a⇩s⇩e None"])
apply(subst Rep_Pair⇩b⇩a⇩s⇩e_inject[symmetric], simp)
apply(subst Pair⇩b⇩a⇩s⇩e.Abs_Pair⇩b⇩a⇩s⇩e_inverse, simp_all,simp add: bot_option_def)
apply(erule contrapos_np[of "x = Abs_Pair⇩b⇩a⇩s⇩e ⌊None⌋"])
apply(subst Rep_Pair⇩b⇩a⇩s⇩e_inject[symmetric], simp)
apply(subst Pair⇩b⇩a⇩s⇩e.Abs_Pair⇩b⇩a⇩s⇩e_inverse, simp_all,simp add: null_option_def bot_option_def)
done
lemma B[simp]:"Rep_Pair⇩b⇩a⇩s⇩e x ≠ None ⟹ Rep_Pair⇩b⇩a⇩s⇩e x ≠ null ⟹ (snd ⌈⌈Rep_Pair⇩b⇩a⇩s⇩e x⌉⌉) ≠ bot"
by(insert Rep_Pair⇩b⇩a⇩s⇩e[of x],auto simp:null_option_def bot_option_def)
lemma B'[simp]:"x ≠ bot ⟹ x ≠ null ⟹ (snd ⌈⌈Rep_Pair⇩b⇩a⇩s⇩e x⌉⌉) ≠ bot"
apply(insert Rep_Pair⇩b⇩a⇩s⇩e[of x], simp add: bot_Pair⇩b⇩a⇩s⇩e_def null_Pair⇩b⇩a⇩s⇩e_def)
apply(auto simp:null_option_def bot_option_def)
apply(erule contrapos_np[of "x = Abs_Pair⇩b⇩a⇩s⇩e None"])
apply(subst Rep_Pair⇩b⇩a⇩s⇩e_inject[symmetric], simp)
apply(subst Pair⇩b⇩a⇩s⇩e.Abs_Pair⇩b⇩a⇩s⇩e_inverse, simp_all,simp add: bot_option_def)
apply(erule contrapos_np[of "x = Abs_Pair⇩b⇩a⇩s⇩e ⌊None⌋"])
apply(subst Rep_Pair⇩b⇩a⇩s⇩e_inject[symmetric], simp)
apply(subst Pair⇩b⇩a⇩s⇩e.Abs_Pair⇩b⇩a⇩s⇩e_inverse, simp_all,simp add: null_option_def bot_option_def)
done
subsection‹Fundamental Properties of Strict Equality \label{sec:pair-strict-eq}›
text‹After the part of foundational operations on sets, we detail here equality on sets.
Strong equality is inherited from the OCL core, but we have to consider
the case of the strict equality. We decide to overload strict equality in the
same way we do for other value's in OCL:›
overloading
StrictRefEq ≡ "StrictRefEq :: [('𝔄,'α::null,'β::null)Pair,('𝔄,'α::null,'β::null)Pair] ⇒ ('𝔄)Boolean"
begin
definition StrictRefEq⇩P⇩a⇩i⇩r :
"((x::('𝔄,'α::null,'β::null)Pair) ≐ y) ≡ (λ τ. if (υ x) τ = true τ ∧ (υ y) τ = true τ
then (x ≜ y)τ
else invalid τ)"
end
text‹Property proof in terms of @{term "profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v"}›
interpretation StrictRefEq⇩P⇩a⇩i⇩r : profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v "λ x y. (x::('𝔄,'α::null,'β::null)Pair) ≐ y"
by unfold_locales (auto simp: StrictRefEq⇩P⇩a⇩i⇩r)
subsection‹Standard Operations Definitions›
text‹This part provides a collection of operators for the Pair type.›
subsubsection‹Definition: Pair Constructor›
definition OclPair::"('𝔄, 'α) val ⇒
('𝔄, 'β) val ⇒
('𝔄,'α::null,'β::null) Pair" ("Pair{(_),(_)}")
where "Pair{X,Y} ≡ (λ τ. if (υ X) τ = true τ ∧ (υ Y) τ = true τ
then Abs_Pair⇩b⇩a⇩s⇩e ⌊⌊(X τ, Y τ)⌋⌋
else invalid τ)"
interpretation OclPair : profile_bin⇩v_⇩v
OclPair "λ x y. Abs_Pair⇩b⇩a⇩s⇩e ⌊⌊(x, y)⌋⌋"
apply(unfold_locales, auto simp: OclPair_def bot_Pair⇩b⇩a⇩s⇩e_def null_Pair⇩b⇩a⇩s⇩e_def)
by(auto simp: Abs_Pair⇩b⇩a⇩s⇩e_inject null_option_def bot_option_def)
subsubsection‹Definition: First›
definition OclFirst::" ('𝔄,'α::null,'β::null) Pair ⇒ ('𝔄, 'α) val" (" _ .First'(')")
where "X .First() ≡ (λ τ. if (δ X) τ = true τ
then fst ⌈⌈Rep_Pair⇩b⇩a⇩s⇩e (X τ)⌉⌉
else invalid τ)"
interpretation OclFirst : profile_mono⇩d OclFirst "λx. fst ⌈⌈Rep_Pair⇩b⇩a⇩s⇩e (x)⌉⌉"
by unfold_locales (auto simp: OclFirst_def)
subsubsection‹Definition: Second›
definition OclSecond::" ('𝔄,'α::null,'β::null) Pair ⇒ ('𝔄, 'β) val" ("_ .Second'(')")
where "X .Second() ≡ (λ τ. if (δ X) τ = true τ
then snd ⌈⌈Rep_Pair⇩b⇩a⇩s⇩e (X τ)⌉⌉
else invalid τ)"
interpretation OclSecond : profile_mono⇩d OclSecond "λx. snd ⌈⌈Rep_Pair⇩b⇩a⇩s⇩e (x)⌉⌉"
by unfold_locales (auto simp: OclSecond_def)
subsection‹Logical Properties›
lemma 1 : "τ ⊨ υ Y ⟹ τ ⊨ Pair{X,Y} .First() ≜ X"
apply(case_tac "¬(τ ⊨ υ X)")
apply(erule foundation7'[THEN iffD2, THEN foundation15[THEN iffD2,
THEN StrongEq_L_subst2_rev]],simp_all add:foundation18')
apply(auto simp: OclValid_def valid_def defined_def StrongEq_def OclFirst_def OclPair_def
true_def false_def invalid_def bot_fun_def null_fun_def)
apply(auto simp: Abs_Pair⇩b⇩a⇩s⇩e_inject null_option_def bot_option_def bot_Pair⇩b⇩a⇩s⇩e_def null_Pair⇩b⇩a⇩s⇩e_def)
by(simp add: Abs_Pair⇩b⇩a⇩s⇩e_inverse)
lemma 2 : "τ ⊨ υ X ⟹ τ ⊨ Pair{X,Y} .Second() ≜ Y"
apply(case_tac "¬(τ ⊨ υ Y)")
apply(erule foundation7'[THEN iffD2, THEN foundation15[THEN iffD2,
THEN StrongEq_L_subst2_rev]],simp_all add:foundation18')
apply(auto simp: OclValid_def valid_def defined_def StrongEq_def OclSecond_def OclPair_def
true_def false_def invalid_def bot_fun_def null_fun_def)
apply(auto simp: Abs_Pair⇩b⇩a⇩s⇩e_inject null_option_def bot_option_def bot_Pair⇩b⇩a⇩s⇩e_def null_Pair⇩b⇩a⇩s⇩e_def)
by(simp add: Abs_Pair⇩b⇩a⇩s⇩e_inverse)
subsection‹Algebraic Execution Properties›
lemma proj1_exec [simp, code_unfold] : "Pair{X,Y} .First() = (if (υ Y) then X else invalid endif)"
apply(rule ext, rename_tac "τ", simp add: foundation22[symmetric])
apply(case_tac "¬(τ ⊨ υ Y)")
apply(erule foundation7'[THEN iffD2,
THEN foundation15[THEN iffD2,
THEN StrongEq_L_subst2_rev]],simp_all)
apply(subgoal_tac "τ ⊨ υ Y")
apply(erule foundation13[THEN iffD2, THEN StrongEq_L_subst2_rev], simp_all)
by(erule 1)
lemma proj2_exec [simp, code_unfold] : "Pair{X,Y} .Second() = (if (υ X) then Y else invalid endif)"
apply(rule ext, rename_tac "τ", simp add: foundation22[symmetric])
apply(case_tac "¬(τ ⊨ υ X)")
apply(erule foundation7'[THEN iffD2, THEN foundation15[THEN iffD2,
THEN StrongEq_L_subst2_rev]],simp_all)
apply(subgoal_tac "τ ⊨ υ X")
apply(erule foundation13[THEN iffD2, THEN StrongEq_L_subst2_rev], simp_all)
by(erule 2)
subsection‹Test Statements›
instantiation Pair⇩b⇩a⇩s⇩e :: (equal,equal)equal
begin
definition "HOL.equal k l ⟷ (k::('a::equal,'b::equal)Pair⇩b⇩a⇩s⇩e) = l"
instance by standard (rule equal_Pair⇩b⇩a⇩s⇩e_def)
end
lemma equal_Pair⇩b⇩a⇩s⇩e_code [code]:
"HOL.equal k (l::('a::{equal,null},'b::{equal,null})Pair⇩b⇩a⇩s⇩e) ⟷ Rep_Pair⇩b⇩a⇩s⇩e k = Rep_Pair⇩b⇩a⇩s⇩e l"
by (auto simp add: equal Pair⇩b⇩a⇩s⇩e.Rep_Pair⇩b⇩a⇩s⇩e_inject)
Assert "τ ⊨ invalid .First() ≜ invalid "
Assert "τ ⊨ null .First() ≜ invalid "
Assert "τ ⊨ null .Second() ≜ invalid .Second() "
Assert "τ ⊨ Pair{invalid, true} ≜ invalid "
Assert "τ ⊨ υ(Pair{null, true}.First())"
Assert "τ ⊨ (Pair{null, true}).First() ≜ null "
Assert "τ ⊨ (Pair{null, Pair{true,invalid}}).First() ≜ invalid "
end
Theory UML_Bag
theory UML_Bag
imports "../basic_types/UML_Void"
"../basic_types/UML_Boolean"
"../basic_types/UML_Integer"
"../basic_types/UML_String"
"../basic_types/UML_Real"
begin
no_notation None ("⊥")
section‹Collection Type Bag: Operations›
definition "Rep_Bag_base' x = {(x0, y). y < ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e x⌉⌉ x0 }"
definition "Rep_Bag_base x τ = {(x0, y). y < ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e (x τ)⌉⌉ x0 }"
definition "Rep_Set_base x τ = fst ` {(x0, y). y < ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e (x τ)⌉⌉ x0 }"
definition ApproxEq (infixl "≅" 30)
where "X ≅ Y ≡ λ τ. ⌊⌊Rep_Set_base X τ = Rep_Set_base Y τ ⌋⌋"
subsection‹As a Motivation for the (infinite) Type Construction: Type-Extensions as Bags
\label{sec:type-extensions}›
text‹Our notion of typed bag goes beyond the usual notion of a finite executable bag and
is powerful enough to capture \emph{the extension of a type} in UML and OCL. This means
we can have in Featherweight OCL Bags containing all possible elements of a type, not only
those (finite) ones representable in a state. This holds for base types as well as class types,
although the notion for class-types --- involving object id's not occurring in a state ---
requires some care.
In a world with @{term invalid} and @{term null}, there are two notions extensions possible:
\begin{enumerate}
\item the bag of all \emph{defined} values of a type @{term T}
(for which we will introduce the constant @{term T})
\item the bag of all \emph{valid} values of a type @{term T}, so including @{term null}
(for which we will introduce the constant @{term T⇩n⇩u⇩l⇩l}).
\end{enumerate}
›
text‹We define the bag extensions for the base type @{term Integer} as follows:›
definition Integer :: "('𝔄,Integer⇩b⇩a⇩s⇩e) Bag"
where "Integer ≡ (λ τ. (Abs_Bag⇩b⇩a⇩s⇩e o Some o Some) (λ None ⇒ 0 | Some None ⇒ 0 | _ ⇒ 1))"
definition Integer⇩n⇩u⇩l⇩l :: "('𝔄,Integer⇩b⇩a⇩s⇩e) Bag"
where "Integer⇩n⇩u⇩l⇩l ≡ (λ τ. (Abs_Bag⇩b⇩a⇩s⇩e o Some o Some) (λ None ⇒ 0 | _ ⇒ 1))"
lemma Integer_defined : "δ Integer = true"
apply(rule ext, auto simp: Integer_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bag⇩b⇩a⇩s⇩e_inject bot_option_def bot_Bag⇩b⇩a⇩s⇩e_def null_Bag⇩b⇩a⇩s⇩e_def null_option_def)
lemma Integer⇩n⇩u⇩l⇩l_defined : "δ Integer⇩n⇩u⇩l⇩l = true"
apply(rule ext, auto simp: Integer⇩n⇩u⇩l⇩l_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bag⇩b⇩a⇩s⇩e_inject bot_option_def bot_Bag⇩b⇩a⇩s⇩e_def null_Bag⇩b⇩a⇩s⇩e_def null_option_def)
text‹This allows the theorems:
‹τ ⊨ δ x ⟹ τ ⊨ (Integer->includes⇩B⇩a⇩g(x))›
‹τ ⊨ δ x ⟹ τ ⊨ Integer ≜ (Integer->including⇩B⇩a⇩g(x))›
and
‹τ ⊨ υ x ⟹ τ ⊨ (Integer⇩n⇩u⇩l⇩l->includes⇩B⇩a⇩g(x))›
‹τ ⊨ υ x ⟹ τ ⊨ Integer⇩n⇩u⇩l⇩l ≜ (Integer⇩n⇩u⇩l⇩l->including⇩B⇩a⇩g(x))›
which characterize the infiniteness of these bags by a recursive property on these bags.
›
text‹In the same spirit, we proceed similarly for the remaining base types:›
definition Void⇩n⇩u⇩l⇩l :: "('𝔄,Void⇩b⇩a⇩s⇩e) Bag"
where "Void⇩n⇩u⇩l⇩l ≡ (λ τ. (Abs_Bag⇩b⇩a⇩s⇩e o Some o Some) (λ x. if x = Abs_Void⇩b⇩a⇩s⇩e (Some None) then 1 else 0))"
definition Void⇩e⇩m⇩p⇩t⇩y :: "('𝔄,Void⇩b⇩a⇩s⇩e) Bag"
where "Void⇩e⇩m⇩p⇩t⇩y ≡ (λ τ. (Abs_Bag⇩b⇩a⇩s⇩e o Some o Some) (λ_. 0))"
lemma Void⇩n⇩u⇩l⇩l_defined : "δ Void⇩n⇩u⇩l⇩l = true"
apply(rule ext, auto simp: Void⇩n⇩u⇩l⇩l_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def
bot_Bag⇩b⇩a⇩s⇩e_def null_Bag⇩b⇩a⇩s⇩e_def)
by((subst (asm) Abs_Bag⇩b⇩a⇩s⇩e_inject, auto simp add: bot_option_def null_option_def bot_Void_def),
(subst (asm) Abs_Void⇩b⇩a⇩s⇩e_inject, auto simp add: bot_option_def null_option_def))+
lemma Void⇩e⇩m⇩p⇩t⇩y_defined : "δ Void⇩e⇩m⇩p⇩t⇩y = true"
apply(rule ext, auto simp: Void⇩e⇩m⇩p⇩t⇩y_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def
bot_Bag⇩b⇩a⇩s⇩e_def null_Bag⇩b⇩a⇩s⇩e_def)
by((subst (asm) Abs_Bag⇩b⇩a⇩s⇩e_inject, auto simp add: bot_option_def null_option_def bot_Void_def))+
lemma assumes "τ ⊨ δ (V :: ('𝔄,Void⇩b⇩a⇩s⇩e) Bag)"
shows "τ ⊨ V ≅ Void⇩n⇩u⇩l⇩l ∨ τ ⊨ V ≅ Void⇩e⇩m⇩p⇩t⇩y"
proof -
have A:"⋀x y. x ≠ {} ⟹ ∃y. y∈ x"
by (metis all_not_in_conv)
show "?thesis"
apply(case_tac "V τ")
proof - fix y show "V τ = Abs_Bag⇩b⇩a⇩s⇩e y ⟹
y ∈ {X. X = ⊥ ∨ X = null ∨ ⌈⌈X⌉⌉ ⊥ = 0} ⟹
τ ⊨ V ≅ Void⇩n⇩u⇩l⇩l ∨ τ ⊨ V ≅ Void⇩e⇩m⇩p⇩t⇩y"
apply(insert assms, case_tac y, simp add: bot_option_def, simp add: bot_Bag⇩b⇩a⇩s⇩e_def foundation16)
apply(simp add: bot_option_def null_option_def)
apply(erule disjE, metis OclValid_def defined_def foundation2 null_Bag⇩b⇩a⇩s⇩e_def null_fun_def true_def)
proof - fix a show "V τ = Abs_Bag⇩b⇩a⇩s⇩e ⌊a⌋ ⟹ ⌈a⌉ ⊥ = 0 ⟹ τ ⊨ V ≅ Void⇩n⇩u⇩l⇩l ∨ τ ⊨ V ≅ Void⇩e⇩m⇩p⇩t⇩y"
apply(case_tac a, simp, insert assms, metis OclValid_def foundation16 null_Bag⇩b⇩a⇩s⇩e_def true_def)
apply(simp)
proof - fix aa show " V τ = Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊aa⌋⌋ ⟹ aa ⊥ = 0 ⟹ τ ⊨ V ≅ Void⇩n⇩u⇩l⇩l ∨ τ ⊨ V ≅ Void⇩e⇩m⇩p⇩t⇩y"
apply(case_tac "aa (Abs_Void⇩b⇩a⇩s⇩e ⌊None⌋) = 0",
rule disjI2,
insert assms,
simp add: Void⇩e⇩m⇩p⇩t⇩y_def OclValid_def ApproxEq_def Rep_Set_base_def true_def Abs_Bag⇩b⇩a⇩s⇩e_inverse image_def)
apply(intro allI)
proof - fix x fix b show " V τ = Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊aa⌋⌋ ⟹ aa ⊥ = 0 ⟹ aa (Abs_Void⇩b⇩a⇩s⇩e ⌊None⌋) = 0 ⟹ (δ V) τ = ⌊⌊True⌋⌋ ⟹ ¬ b < aa x"
apply (case_tac x, auto)
apply (simp add: bot_Void_def bot_option_def)
apply (simp add: bot_option_def null_option_def)
done
apply_end(simp+, rule disjI1)
show "V τ = Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊aa⌋⌋ ⟹ aa ⊥ = 0 ⟹ 0 < aa (Abs_Void⇩b⇩a⇩s⇩e ⌊None⌋) ⟹ τ ⊨ δ V ⟹ τ ⊨ V ≅ Void⇩n⇩u⇩l⇩l"
apply(simp add: Void⇩n⇩u⇩l⇩l_def OclValid_def ApproxEq_def Rep_Set_base_def true_def Abs_Bag⇩b⇩a⇩s⇩e_inverse image_def,
subst Abs_Bag⇩b⇩a⇩s⇩e_inverse, simp)
using bot_Void_def apply auto[1]
apply(simp)
apply(rule equalityI, rule subsetI, simp)
proof - fix x show "V τ = Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊aa⌋⌋ ⟹
aa ⊥ = 0 ⟹ 0 < aa (Abs_Void⇩b⇩a⇩s⇩e ⌊None⌋) ⟹ (δ V) τ = ⌊⌊True⌋⌋ ⟹ ∃b. b < aa x ⟹ x = Abs_Void⇩b⇩a⇩s⇩e ⌊None⌋"
apply( case_tac x, auto)
apply (simp add: bot_Void_def bot_option_def)
by (simp add: bot_option_def null_option_def)
qed ((simp add: bot_Void_def bot_option_def)+, blast)
qed qed qed qed qed
definition Boolean :: "('𝔄,Boolean⇩b⇩a⇩s⇩e) Bag"
where "Boolean ≡ (λ τ. (Abs_Bag⇩b⇩a⇩s⇩e o Some o Some) (λ None ⇒ 0 | Some None ⇒ 0 | _ ⇒ 1))"
definition Boolean⇩n⇩u⇩l⇩l :: "('𝔄,Boolean⇩b⇩a⇩s⇩e) Bag"
where "Boolean⇩n⇩u⇩l⇩l ≡ (λ τ. (Abs_Bag⇩b⇩a⇩s⇩e o Some o Some) (λ None ⇒ 0 | _ ⇒ 1))"
lemma Boolean_defined : "δ Boolean = true"
apply(rule ext, auto simp: Boolean_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bag⇩b⇩a⇩s⇩e_inject bot_option_def bot_Bag⇩b⇩a⇩s⇩e_def null_Bag⇩b⇩a⇩s⇩e_def null_option_def)
lemma Boolean⇩n⇩u⇩l⇩l_defined : "δ Boolean⇩n⇩u⇩l⇩l = true"
apply(rule ext, auto simp: Boolean⇩n⇩u⇩l⇩l_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bag⇩b⇩a⇩s⇩e_inject bot_option_def bot_Bag⇩b⇩a⇩s⇩e_def null_Bag⇩b⇩a⇩s⇩e_def null_option_def)
definition String :: "('𝔄,String⇩b⇩a⇩s⇩e) Bag"
where "String ≡ (λ τ. (Abs_Bag⇩b⇩a⇩s⇩e o Some o Some) (λ None ⇒ 0 | Some None ⇒ 0 | _ ⇒ 1))"
definition String⇩n⇩u⇩l⇩l :: "('𝔄,String⇩b⇩a⇩s⇩e) Bag"
where "String⇩n⇩u⇩l⇩l ≡ (λ τ. (Abs_Bag⇩b⇩a⇩s⇩e o Some o Some) (λ None ⇒ 0 | _ ⇒ 1))"
lemma String_defined : "δ String = true"
apply(rule ext, auto simp: String_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bag⇩b⇩a⇩s⇩e_inject bot_option_def bot_Bag⇩b⇩a⇩s⇩e_def null_Bag⇩b⇩a⇩s⇩e_def null_option_def)
lemma String⇩n⇩u⇩l⇩l_defined : "δ String⇩n⇩u⇩l⇩l = true"
apply(rule ext, auto simp: String⇩n⇩u⇩l⇩l_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bag⇩b⇩a⇩s⇩e_inject bot_option_def bot_Bag⇩b⇩a⇩s⇩e_def null_Bag⇩b⇩a⇩s⇩e_def null_option_def)
definition Real :: "('𝔄,Real⇩b⇩a⇩s⇩e) Bag"
where "Real ≡ (λ τ. (Abs_Bag⇩b⇩a⇩s⇩e o Some o Some) (λ None ⇒ 0 | Some None ⇒ 0 | _ ⇒ 1))"
definition Real⇩n⇩u⇩l⇩l :: "('𝔄,Real⇩b⇩a⇩s⇩e) Bag"
where "Real⇩n⇩u⇩l⇩l ≡ (λ τ. (Abs_Bag⇩b⇩a⇩s⇩e o Some o Some) (λ None ⇒ 0 | _ ⇒ 1))"
lemma Real_defined : "δ Real = true"
apply(rule ext, auto simp: Real_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bag⇩b⇩a⇩s⇩e_inject bot_option_def bot_Bag⇩b⇩a⇩s⇩e_def null_Bag⇩b⇩a⇩s⇩e_def null_option_def)
lemma Real⇩n⇩u⇩l⇩l_defined : "δ Real⇩n⇩u⇩l⇩l = true"
apply(rule ext, auto simp: Real⇩n⇩u⇩l⇩l_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Bag⇩b⇩a⇩s⇩e_inject bot_option_def bot_Bag⇩b⇩a⇩s⇩e_def null_Bag⇩b⇩a⇩s⇩e_def null_option_def)
subsection‹Basic Properties of the Bag Type›
text‹Every element in a defined bag is valid.›
lemma Bag_inv_lemma: "τ ⊨ (δ X) ⟹ ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e (X τ)⌉⌉ bot = 0"
apply(insert Rep_Bag⇩b⇩a⇩s⇩e [of "X τ"], simp)
apply(auto simp: OclValid_def defined_def false_def true_def cp_def
bot_fun_def bot_Bag⇩b⇩a⇩s⇩e_def null_Bag⇩b⇩a⇩s⇩e_def null_fun_def
split:if_split_asm)
apply(erule contrapos_pp [of "Rep_Bag⇩b⇩a⇩s⇩e (X τ) = bot"])
apply(subst Abs_Bag⇩b⇩a⇩s⇩e_inject[symmetric], rule Rep_Bag⇩b⇩a⇩s⇩e, simp)
apply(simp add: Rep_Bag⇩b⇩a⇩s⇩e_inverse bot_Bag⇩b⇩a⇩s⇩e_def bot_option_def)
apply(erule contrapos_pp [of "Rep_Bag⇩b⇩a⇩s⇩e (X τ) = null"])
apply(subst Abs_Bag⇩b⇩a⇩s⇩e_inject[symmetric], rule Rep_Bag⇩b⇩a⇩s⇩e, simp)
apply(simp add: Rep_Bag⇩b⇩a⇩s⇩e_inverse null_option_def)
by (simp add: bot_option_def)
lemma Bag_inv_lemma' :
assumes x_def : "τ ⊨ δ X"
and e_mem : "⌈⌈Rep_Bag⇩b⇩a⇩s⇩e (X τ)⌉⌉ e ≥ 1"
shows "τ ⊨ υ (λ_. e)"
apply(case_tac "e = bot", insert assms, drule Bag_inv_lemma, simp)
by (simp add: foundation18')
lemma abs_rep_simp' :
assumes S_all_def : "τ ⊨ δ S"
shows "Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Bag⇩b⇩a⇩s⇩e (S τ)⌉⌉⌋⌋ = S τ"
proof -
have discr_eq_false_true : "⋀τ. (false τ = true τ) = False" by(simp add: false_def true_def)
show ?thesis
apply(insert S_all_def, simp add: OclValid_def defined_def)
apply(rule mp[OF Abs_Bag⇩b⇩a⇩s⇩e_induct[where P = "λS. (if S = ⊥ τ ∨ S = null τ
then false τ else true τ) = true τ ⟶
Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Bag⇩b⇩a⇩s⇩e S⌉⌉⌋⌋ = S"]],
rename_tac S')
apply(simp add: Abs_Bag⇩b⇩a⇩s⇩e_inverse discr_eq_false_true)
apply(case_tac S') apply(simp add: bot_fun_def bot_Bag⇩b⇩a⇩s⇩e_def)+
apply(rename_tac S'', case_tac S'') apply(simp add: null_fun_def null_Bag⇩b⇩a⇩s⇩e_def)+
done
qed
lemma invalid_bag_OclNot_defined [simp,code_unfold]:"δ(invalid::('𝔄,'α::null) Bag) = false" by simp
lemma null_bag_OclNot_defined [simp,code_unfold]:"δ(null::('𝔄,'α::null) Bag) = false"
by(simp add: defined_def null_fun_def)
lemma invalid_bag_valid [simp,code_unfold]:"υ(invalid::('𝔄,'α::null) Bag) = false"
by simp
lemma null_bag_valid [simp,code_unfold]:"υ(null::('𝔄,'α::null) Bag) = true"
apply(simp add: valid_def null_fun_def bot_fun_def bot_Bag⇩b⇩a⇩s⇩e_def null_Bag⇩b⇩a⇩s⇩e_def)
apply(subst Abs_Bag⇩b⇩a⇩s⇩e_inject,simp_all add: null_option_def bot_option_def)
done
text‹... which means that we can have a type ‹('𝔄,('𝔄,('𝔄) Integer) Bag) Bag›
corresponding exactly to Bag(Bag(Integer)) in OCL notation. Note that the parameter
‹'𝔄› still refers to the object universe; making the OCL semantics entirely parametric
in the object universe makes it possible to study (and prove) its properties
independently from a concrete class diagram.›
subsection‹Definition: Strict Equality \label{sec:bag-strict-equality}›
text‹After the part of foundational operations on bags, we detail here equality on bags.
Strong equality is inherited from the OCL core, but we have to consider
the case of the strict equality. We decide to overload strict equality in the
same way we do for other value's in OCL:›
overloading StrictRefEq ≡ "StrictRefEq :: [('𝔄,'α::null)Bag,('𝔄,'α::null)Bag] ⇒ ('𝔄)Boolean"
begin
definition StrictRefEq⇩B⇩a⇩g :
"(x::('𝔄,'α::null)Bag) ≐ y ≡ λ τ. if (υ x) τ = true τ ∧ (υ y) τ = true τ
then (x ≜ y)τ
else invalid τ"
end
text‹One might object here that for the case of objects, this is an empty definition.
The answer is no, we will restrain later on states and objects such that any object
has its oid stored inside the object (so the ref, under which an object can be referenced
in the store will represented in the object itself). For such well-formed stores that satisfy
this invariant (the WFF-invariant), the referential equality and the
strong equality---and therefore the strict equality on bags in the sense above---coincides.›
text‹Property proof in terms of @{term "profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v"}›
interpretation StrictRefEq⇩B⇩a⇩g : profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v "λ x y. (x::('𝔄,'α::null)Bag) ≐ y"
by unfold_locales (auto simp: StrictRefEq⇩B⇩a⇩g)
subsection‹Constants: mtBag›
definition mtBag::"('𝔄,'α::null) Bag" ("Bag{}")
where "Bag{} ≡ (λ τ. Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊λ_. 0::nat⌋⌋ )"
lemma mtBag_defined[simp,code_unfold]:"δ(Bag{}) = true"
apply(rule ext, auto simp: mtBag_def defined_def null_Bag⇩b⇩a⇩s⇩e_def
bot_Bag⇩b⇩a⇩s⇩e_def bot_fun_def null_fun_def)
by(simp_all add: Abs_Bag⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
lemma mtBag_valid[simp,code_unfold]:"υ(Bag{}) = true"
apply(rule ext,auto simp: mtBag_def valid_def
bot_Bag⇩b⇩a⇩s⇩e_def bot_fun_def null_fun_def)
by(simp_all add: Abs_Bag⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
lemma mtBag_rep_bag: "⌈⌈Rep_Bag⇩b⇩a⇩s⇩e (Bag{} τ)⌉⌉ = (λ _. 0)"
apply(simp add: mtBag_def, subst Abs_Bag⇩b⇩a⇩s⇩e_inverse)
by(simp add: bot_option_def)+
text_raw‹\isatagafp›
lemma [simp,code_unfold]: "const Bag{}"
by(simp add: const_def mtBag_def)
text‹Note that the collection types in OCL allow for null to be included;
however, there is the null-collection into which inclusion yields invalid.›
text_raw‹\endisatagafp›
subsection‹Definition: Including›
definition OclIncluding :: "[('𝔄,'α::null) Bag,('𝔄,'α) val] ⇒ ('𝔄,'α) Bag"
where "OclIncluding x y = (λ τ. if (δ x) τ = true τ ∧ (υ y) τ = true τ
then Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊ ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e(x τ)⌉⌉
((y τ):=⌈⌈Rep_Bag⇩b⇩a⇩s⇩e(x τ)⌉⌉(y τ)+1)
⌋⌋
else invalid τ )"
notation OclIncluding ("_->including⇩B⇩a⇩g'(_')")
interpretation OclIncluding : profile_bin⇩d_⇩v OclIncluding "λx y. Abs_Bag⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Bag⇩b⇩a⇩s⇩e x⌉⌉
(y := ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e x⌉⌉ y + 1)⌋⌋"
proof -
let ?X = "λx y. ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e(x)⌉⌉ ((y):=⌈⌈Rep_Bag⇩b⇩a⇩s⇩e(x)⌉⌉( y )+1)"
show "profile_bin⇩d_⇩v OclIncluding (λx y. Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊ ?X x y ⌋⌋)"
apply unfold_locales
apply(auto simp:OclIncluding_def bot_option_def null_option_def
bot_Bag⇩b⇩a⇩s⇩e_def null_Bag⇩b⇩a⇩s⇩e_def)
by(subst (asm) Abs_Bag⇩b⇩a⇩s⇩e_inject, simp_all,
metis (mono_tags, lifting) Rep_Bag⇩b⇩a⇩s⇩e Rep_Bag⇩b⇩a⇩s⇩e_inverse bot_option_def mem_Collect_eq null_option_def,
simp add: bot_option_def null_option_def)+
qed
syntax
"_OclFinbag" :: "args => ('𝔄,'a::null) Bag" ("Bag{(_)}")
translations
"Bag{x, xs}" == "CONST OclIncluding (Bag{xs}) x"
"Bag{x}" == "CONST OclIncluding (Bag{}) x "
subsection‹Definition: Excluding›
definition OclExcluding :: "[('𝔄,'α::null) Bag,('𝔄,'α) val] ⇒ ('𝔄,'α) Bag"
where "OclExcluding x y = (λ τ. if (δ x) τ = true τ ∧ (υ y) τ = true τ
then Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊ ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e (x τ)⌉⌉ ((y τ):=0::nat) ⌋⌋
else invalid τ )"
notation OclExcluding ("_->excluding⇩B⇩a⇩g'(_')")
interpretation OclExcluding: profile_bin⇩d_⇩v OclExcluding
"λx y. Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Bag⇩b⇩a⇩s⇩e(x)⌉⌉(y:=0::nat)⌋⌋"
proof -
show "profile_bin⇩d_⇩v OclExcluding (λx y. Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Bag⇩b⇩a⇩s⇩e x⌉⌉(y := 0)⌋⌋)"
apply unfold_locales
apply(auto simp:OclExcluding_def bot_option_def null_option_def
null_Bag⇩b⇩a⇩s⇩e_def bot_Bag⇩b⇩a⇩s⇩e_def)
by(subst (asm) Abs_Bag⇩b⇩a⇩s⇩e_inject,
simp_all add: bot_option_def null_option_def,
metis (mono_tags, lifting) Rep_Bag⇩b⇩a⇩s⇩e Rep_Bag⇩b⇩a⇩s⇩e_inverse bot_option_def
mem_Collect_eq null_option_def)+
qed
subsection‹Definition: Includes›
definition OclIncludes :: "[('𝔄,'α::null) Bag,('𝔄,'α) val] ⇒ '𝔄 Boolean"
where "OclIncludes x y = (λ τ. if (δ x) τ = true τ ∧ (υ y) τ = true τ
then ⌊⌊ ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e (x τ)⌉⌉ (y τ) > 0 ⌋⌋
else ⊥ )"
notation OclIncludes ("_->includes⇩B⇩a⇩g'(_')" )
interpretation OclIncludes : profile_bin⇩d_⇩v OclIncludes "λx y. ⌊⌊ ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e x⌉⌉ y > 0 ⌋⌋"
by(unfold_locales, auto simp:OclIncludes_def bot_option_def null_option_def invalid_def)
subsection‹Definition: Excludes›
definition OclExcludes :: "[('𝔄,'α::null) Bag,('𝔄,'α) val] ⇒ '𝔄 Boolean"
where "OclExcludes x y = (not(OclIncludes x y))"
notation OclExcludes ("_->excludes⇩B⇩a⇩g'(_')" )
text‹The case of the size definition is somewhat special, we admit
explicitly in Featherweight OCL the possibility of infinite bags. For
the size definition, this requires an extra condition that assures
that the cardinality of the bag is actually a defined integer.›
interpretation OclExcludes : profile_bin⇩d_⇩v OclExcludes "λx y. ⌊⌊ ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e x⌉⌉ y ≤ 0 ⌋⌋"
by(unfold_locales, auto simp:OclExcludes_def OclIncludes_def OclNot_def bot_option_def null_option_def invalid_def)
subsection‹Definition: Size›
definition OclSize :: "('𝔄,'α::null)Bag ⇒ '𝔄 Integer"
where "OclSize x = (λ τ. if (δ x) τ = true τ ∧ finite (Rep_Bag_base x τ)
then ⌊⌊ int (card (Rep_Bag_base x τ)) ⌋⌋
else ⊥ )"
notation
OclSize ("_->size⇩B⇩a⇩g'(')" )
text‹The following definition follows the requirement of the
standard to treat null as neutral element of bags. It is
a well-documented exception from the general strictness
rule and the rule that the distinguished argument self should
be non-null.›
subsection‹Definition: IsEmpty›
definition OclIsEmpty :: "('𝔄,'α::null) Bag ⇒ '𝔄 Boolean"
where "OclIsEmpty x = ((υ x and not (δ x)) or ((OclSize x) ≐ 𝟬))"
notation OclIsEmpty ("_->isEmpty⇩B⇩a⇩g'(')" )
subsection‹Definition: NotEmpty›
definition OclNotEmpty :: "('𝔄,'α::null) Bag ⇒ '𝔄 Boolean"
where "OclNotEmpty x = not(OclIsEmpty x)"
notation OclNotEmpty ("_->notEmpty⇩B⇩a⇩g'(')" )
subsection‹Definition: Any›
definition OclANY :: "[('𝔄,'α::null) Bag] ⇒ ('𝔄,'α) val"
where "OclANY x = (λ τ. if (υ x) τ = true τ
then if (δ x and OclNotEmpty x) τ = true τ
then SOME y. y ∈ (Rep_Set_base x τ)
else null τ
else ⊥ )"
notation OclANY ("_->any⇩B⇩a⇩g'(')")
subsection‹Definition: Forall›
text‹The definition of OclForall mimics the one of @{term "OclAnd"}:
OclForall is not a strict operation.›
definition OclForall :: "[('𝔄,'α::null)Bag,('𝔄,'α)val⇒('𝔄)Boolean] ⇒ '𝔄 Boolean"
where "OclForall S P = (λ τ. if (δ S) τ = true τ
then if (∃x∈Rep_Set_base S τ. P (λ_. x) τ = false τ)
then false τ
else if (∃x∈Rep_Set_base S τ. P (λ_. x) τ = invalid τ)
then invalid τ
else if (∃x∈Rep_Set_base S τ. P (λ_. x) τ = null τ)
then null τ
else true τ
else ⊥)"
syntax
"_OclForallBag" :: "[('𝔄,'α::null) Bag,id,('𝔄)Boolean] ⇒ '𝔄 Boolean" ("(_)->forAll⇩B⇩a⇩g'(_|_')")
translations
"X->forAll⇩B⇩a⇩g(x | P)" == "CONST UML_Bag.OclForall X (%x. P)"
subsection‹Definition: Exists›
text‹Like OclForall, OclExists is also not strict.›
definition OclExists :: "[('𝔄,'α::null) Bag,('𝔄,'α)val⇒('𝔄)Boolean] ⇒ '𝔄 Boolean"
where "OclExists S P = not(UML_Bag.OclForall S (λ X. not (P X)))"
syntax
"_OclExistBag" :: "[('𝔄,'α::null) Bag,id,('𝔄)Boolean] ⇒ '𝔄 Boolean" ("(_)->exists⇩B⇩a⇩g'(_|_')")
translations
"X->exists⇩B⇩a⇩g(x | P)" == "CONST UML_Bag.OclExists X (%x. P)"
subsection‹Definition: Iterate›
definition OclIterate :: "[('𝔄,'α::null) Bag,('𝔄,'β::null)val,
('𝔄,'α)val⇒('𝔄,'β)val⇒('𝔄,'β)val] ⇒ ('𝔄,'β)val"
where "OclIterate S A F = (λ τ. if (δ S) τ = true τ ∧ (υ A) τ = true τ ∧ finite (Rep_Bag_base S τ)
then Finite_Set.fold (F o (λa τ. a) o fst) A (Rep_Bag_base S τ) τ
else ⊥)"
syntax
"_OclIterateBag" :: "[('𝔄,'α::null) Bag, idt, idt, 'α, 'β] => ('𝔄,'γ)val"
("_ ->iterate⇩B⇩a⇩g'(_;_=_ | _')" )
translations
"X->iterate⇩B⇩a⇩g(a; x = A | P)" == "CONST OclIterate X A (%a. (% x. P))"
subsection‹Definition: Select›
definition OclSelect :: "[('𝔄,'α::null)Bag,('𝔄,'α)val⇒('𝔄)Boolean] ⇒ ('𝔄,'α)Bag"
where "OclSelect S P = (λτ. if (δ S) τ = true τ
then if (∃x∈Rep_Set_base S τ. P(λ _. x) τ = invalid τ)
then invalid τ
else Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊λx.
let n = ⌈⌈ Rep_Bag⇩b⇩a⇩s⇩e (S τ) ⌉⌉ x in
if n = 0 | P (λ_. x) τ = false τ then
0
else
n⌋⌋
else invalid τ)"
syntax
"_OclSelectBag" :: "[('𝔄,'α::null) Bag,id,('𝔄)Boolean] ⇒ '𝔄 Boolean" ("(_)->select⇩B⇩a⇩g'(_|_')")
translations
"X->select⇩B⇩a⇩g(x | P)" == "CONST OclSelect X (% x. P)"
subsection‹Definition: Reject›
definition OclReject :: "[('𝔄,'α::null)Bag,('𝔄,'α)val⇒('𝔄)Boolean] ⇒ ('𝔄,'α::null)Bag"
where "OclReject S P = OclSelect S (not o P)"
syntax
"_OclRejectBag" :: "[('𝔄,'α::null) Bag,id,('𝔄)Boolean] ⇒ '𝔄 Boolean" ("(_)->reject⇩B⇩a⇩g'(_|_')")
translations
"X->reject⇩B⇩a⇩g(x | P)" == "CONST OclReject X (% x. P)"
subsection‹Definition: IncludesAll›
definition OclIncludesAll :: "[('𝔄,'α::null) Bag,('𝔄,'α) Bag] ⇒ '𝔄 Boolean"
where "OclIncludesAll x y = (λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊Rep_Bag_base y τ ⊆ Rep_Bag_base x τ ⌋⌋
else ⊥ )"
notation OclIncludesAll ("_->includesAll⇩B⇩a⇩g'(_')" )
interpretation OclIncludesAll : profile_bin⇩d_⇩d OclIncludesAll "λx y. ⌊⌊Rep_Bag_base' y ⊆ Rep_Bag_base' x ⌋⌋"
by(unfold_locales, auto simp:OclIncludesAll_def bot_option_def null_option_def invalid_def
Rep_Bag_base_def Rep_Bag_base'_def)
subsection‹Definition: ExcludesAll›
definition OclExcludesAll :: "[('𝔄,'α::null) Bag,('𝔄,'α) Bag] ⇒ '𝔄 Boolean"
where "OclExcludesAll x y = (λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊Rep_Bag_base y τ ∩ Rep_Bag_base x τ = {} ⌋⌋
else ⊥ )"
notation OclExcludesAll ("_->excludesAll⇩B⇩a⇩g'(_')" )
interpretation OclExcludesAll : profile_bin⇩d_⇩d OclExcludesAll "λx y. ⌊⌊Rep_Bag_base' y ∩ Rep_Bag_base' x = {} ⌋⌋"
by(unfold_locales, auto simp:OclExcludesAll_def bot_option_def null_option_def invalid_def
Rep_Bag_base_def Rep_Bag_base'_def)
subsection‹Definition: Union›
definition OclUnion :: "[('𝔄,'α::null) Bag,('𝔄,'α) Bag] ⇒ ('𝔄,'α) Bag"
where "OclUnion x y = (λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊ λ X. ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e (x τ)⌉⌉ X +
⌈⌈Rep_Bag⇩b⇩a⇩s⇩e (y τ)⌉⌉ X⌋⌋
else invalid τ )"
notation OclUnion ("_->union⇩B⇩a⇩g'(_')" )
interpretation OclUnion :
profile_bin⇩d_⇩d OclUnion "λx y. Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊ λ X. ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e x⌉⌉ X +
⌈⌈Rep_Bag⇩b⇩a⇩s⇩e y⌉⌉ X⌋⌋"
proof -
show "profile_bin⇩d_⇩d OclUnion (λx y. Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊ λ X. ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e x⌉⌉ X + ⌈⌈Rep_Bag⇩b⇩a⇩s⇩e y⌉⌉ X⌋⌋)"
apply unfold_locales
apply(auto simp:OclUnion_def bot_option_def null_option_def
null_Bag⇩b⇩a⇩s⇩e_def bot_Bag⇩b⇩a⇩s⇩e_def)
by(subst (asm) Abs_Bag⇩b⇩a⇩s⇩e_inject,
simp_all add: bot_option_def null_option_def,
metis (mono_tags, lifting) Rep_Bag⇩b⇩a⇩s⇩e Rep_Bag⇩b⇩a⇩s⇩e_inverse bot_option_def mem_Collect_eq
null_option_def)+
qed
subsection‹Definition: Intersection›
definition OclIntersection :: "[('𝔄,'α::null) Bag,('𝔄,'α) Bag] ⇒ ('𝔄,'α) Bag"
where "OclIntersection x y = (λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then Abs_Bag⇩b⇩a⇩s⇩e⌊⌊ λ X. min (⌈⌈Rep_Bag⇩b⇩a⇩s⇩e (x τ)⌉⌉ X)
(⌈⌈Rep_Bag⇩b⇩a⇩s⇩e (y τ)⌉⌉ X)⌋⌋
else ⊥ )"
notation OclIntersection("_->intersection⇩B⇩a⇩g'(_')" )
interpretation OclIntersection :
profile_bin⇩d_⇩d OclIntersection "λx y. Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊ λ X. min (⌈⌈Rep_Bag⇩b⇩a⇩s⇩e x⌉⌉ X)
(⌈⌈Rep_Bag⇩b⇩a⇩s⇩e y⌉⌉ X)⌋⌋"
proof -
show "profile_bin⇩d_⇩d OclIntersection (λx y. Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊ λ X. min (⌈⌈Rep_Bag⇩b⇩a⇩s⇩e x⌉⌉ X)
(⌈⌈Rep_Bag⇩b⇩a⇩s⇩e y⌉⌉ X)⌋⌋)"
apply unfold_locales
apply(auto simp:OclIntersection_def bot_option_def null_option_def
null_Bag⇩b⇩a⇩s⇩e_def bot_Bag⇩b⇩a⇩s⇩e_def invalid_def)
by(subst (asm) Abs_Bag⇩b⇩a⇩s⇩e_inject,
simp_all add: bot_option_def null_option_def,
metis (mono_tags, lifting) Rep_Bag⇩b⇩a⇩s⇩e Rep_Bag⇩b⇩a⇩s⇩e_inverse bot_option_def mem_Collect_eq min_0R
null_option_def)+
qed
subsection‹Definition: Count›
definition OclCount :: "[('𝔄,'α::null) Bag,('𝔄,'α) val] ⇒ ('𝔄) Integer"
where "OclCount x y = (λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊int(⌈⌈Rep_Bag⇩b⇩a⇩s⇩e (x τ)⌉⌉ (y τ))⌋⌋
else invalid τ )"
notation OclCount ("_->count⇩B⇩a⇩g'(_')" )
interpretation OclCount : profile_bin⇩d_⇩d OclCount "λx y. ⌊⌊int(⌈⌈Rep_Bag⇩b⇩a⇩s⇩e x⌉⌉ y)⌋⌋"
by(unfold_locales, auto simp:OclCount_def bot_option_def null_option_def)
subsection‹Definition (future operators)›
consts
OclSum :: " ('𝔄,'α::null) Bag ⇒ '𝔄 Integer"
notation OclSum ("_->sum⇩B⇩a⇩g'(')" )
subsection‹Logical Properties›
text‹OclIncluding›
lemma OclIncluding_valid_args_valid:
"(τ ⊨ υ(X->including⇩B⇩a⇩g(x))) = ((τ ⊨(δ X)) ∧ (τ ⊨(υ x)))"
by (metis (hide_lams, no_types) OclIncluding.def_valid_then_def OclIncluding.defined_args_valid)
lemma OclIncluding_valid_args_valid''[simp,code_unfold]:
"υ(X->including⇩B⇩a⇩g(x)) = ((δ X) and (υ x))"
by (simp add: OclIncluding.def_valid_then_def)
text‹etc. etc.›
text_raw‹\isatagafp›
text‹OclExcluding›
lemma OclExcluding_valid_args_valid:
"(τ ⊨ υ(X->excluding⇩B⇩a⇩g(x))) = ((τ ⊨(δ X)) ∧ (τ ⊨(υ x)))"
by (metis OclExcluding.def_valid_then_def OclExcluding.defined_args_valid)
lemma OclExcluding_valid_args_valid''[simp,code_unfold]:
"υ(X->excluding⇩B⇩a⇩g(x)) = ((δ X) and (υ x))"
by (simp add: OclExcluding.def_valid_then_def)
text‹OclIncludes›
lemma OclIncludes_valid_args_valid:
"(τ ⊨ υ(X->includes⇩B⇩a⇩g(x))) = ((τ ⊨(δ X)) ∧ (τ ⊨(υ x)))"
by (simp add: OclIncludes.def_valid_then_def foundation10')
lemma OclIncludes_valid_args_valid''[simp,code_unfold]:
"υ(X->includes⇩B⇩a⇩g(x)) = ((δ X) and (υ x))"
by (simp add: OclIncludes.def_valid_then_def)
text‹OclExcludes›
lemma OclExcludes_valid_args_valid:
"(τ ⊨ υ(X->excludes⇩B⇩a⇩g(x))) = ((τ ⊨(δ X)) ∧ (τ ⊨(υ x)))"
by (simp add: OclExcludes.def_valid_then_def foundation10')
lemma OclExcludes_valid_args_valid''[simp,code_unfold]:
"υ(X->excludes⇩B⇩a⇩g(x)) = ((δ X) and (υ x))"
by (simp add: OclExcludes.def_valid_then_def)
text‹OclSize›
lemma OclSize_defined_args_valid: "τ ⊨ δ (X->size⇩B⇩a⇩g()) ⟹ τ ⊨ δ X"
by(auto simp: OclSize_def OclValid_def true_def valid_def false_def StrongEq_def
defined_def invalid_def bot_fun_def null_fun_def
split: bool.split_asm HOL.if_split_asm option.split)
lemma OclSize_infinite:
assumes non_finite:"τ ⊨ not(δ(S->size⇩B⇩a⇩g()))"
shows "(τ ⊨ not(δ(S))) ∨ ¬ finite (Rep_Bag_base S τ)"
apply(insert non_finite, simp)
apply(rule impI)
apply(simp add: OclSize_def OclValid_def defined_def bot_fun_def null_fun_def bot_option_def null_option_def
split: if_split_asm)
done
lemma "τ ⊨ δ X ⟹ ¬ finite (Rep_Bag_base X τ) ⟹ ¬ τ ⊨ δ (X->size⇩B⇩a⇩g())"
by(simp add: OclSize_def OclValid_def defined_def bot_fun_def false_def true_def)
lemma size_defined:
assumes X_finite: "⋀τ. finite (Rep_Bag_base X τ)"
shows "δ (X->size⇩B⇩a⇩g()) = δ X"
apply(rule ext, simp add: cp_defined[of "X->size⇩B⇩a⇩g()"] OclSize_def)
apply(simp add: defined_def bot_option_def bot_fun_def null_option_def null_fun_def X_finite)
done
lemma size_defined':
assumes X_finite: "finite (Rep_Bag_base X τ)"
shows "(τ ⊨ δ (X->size⇩B⇩a⇩g())) = (τ ⊨ δ X)"
apply(simp add: cp_defined[of "X->size⇩B⇩a⇩g()"] OclSize_def OclValid_def)
apply(simp add: defined_def bot_option_def bot_fun_def null_option_def null_fun_def X_finite)
done
text‹OclIsEmpty›
lemma OclIsEmpty_defined_args_valid:"τ ⊨ δ (X->isEmpty⇩B⇩a⇩g()) ⟹ τ ⊨ υ X"
apply(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def
bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def
split: if_split_asm)
apply(case_tac "(X->size⇩B⇩a⇩g() ≐ 𝟬) τ", simp add: bot_option_def, simp, rename_tac x)
apply(case_tac x, simp add: null_option_def bot_option_def, simp)
apply(simp add: OclSize_def StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r valid_def)
by (metis (hide_lams, no_types)
bot_fun_def OclValid_def defined_def foundation2 invalid_def)
lemma "τ ⊨ δ (null->isEmpty⇩B⇩a⇩g())"
by(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def
bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def null_is_valid
split: if_split_asm)
lemma OclIsEmpty_infinite: "τ ⊨ δ X ⟹ ¬ finite (Rep_Bag_base X τ) ⟹ ¬ τ ⊨ δ (X->isEmpty⇩B⇩a⇩g())"
apply(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def
bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def
split: if_split_asm)
apply(case_tac "(X->size⇩B⇩a⇩g() ≐ 𝟬) τ", simp add: bot_option_def, simp, rename_tac x)
apply(case_tac x, simp add: null_option_def bot_option_def, simp)
by(simp add: OclSize_def StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r valid_def bot_fun_def false_def true_def invalid_def)
text‹OclNotEmpty›
lemma OclNotEmpty_defined_args_valid:"τ ⊨ δ (X->notEmpty⇩B⇩a⇩g()) ⟹ τ ⊨ υ X"
by (metis (hide_lams, no_types) OclNotEmpty_def OclNot_defargs OclNot_not foundation6 foundation9
OclIsEmpty_defined_args_valid)
lemma "τ ⊨ δ (null->notEmpty⇩B⇩a⇩g())"
by (metis (hide_lams, no_types) OclNotEmpty_def OclAnd_false1 OclAnd_idem OclIsEmpty_def
OclNot3 OclNot4 OclOr_def defined2 defined4 transform1 valid2)
lemma OclNotEmpty_infinite: "τ ⊨ δ X ⟹ ¬ finite (Rep_Bag_base X τ) ⟹ ¬ τ ⊨ δ (X->notEmpty⇩B⇩a⇩g())"
apply(simp add: OclNotEmpty_def)
apply(drule OclIsEmpty_infinite, simp)
by (metis OclNot_defargs OclNot_not foundation6 foundation9)
lemma OclNotEmpty_has_elt : "τ ⊨ δ X ⟹
τ ⊨ X->notEmpty⇩B⇩a⇩g() ⟹
∃e. e ∈ (Rep_Bag_base X τ)"
proof -
have s_non_empty: "⋀S. S ≠ {} ⟹ ∃x. x ∈ S"
by blast
show "τ ⊨ δ X ⟹
τ ⊨ X->notEmpty⇩B⇩a⇩g() ⟹
?thesis"
apply(simp add: OclNotEmpty_def OclIsEmpty_def deMorgan1 deMorgan2, drule foundation5)
apply(subst (asm) (2) OclNot_def,
simp add: OclValid_def StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r StrongEq_def
split: if_split_asm)
prefer 2
apply(simp add: invalid_def bot_option_def true_def)
apply(simp add: OclSize_def valid_def split: if_split_asm,
simp_all add: false_def true_def bot_option_def bot_fun_def OclInt0_def)
apply(drule s_non_empty[of "Rep_Bag_base X τ"], erule exE, case_tac x)
by blast
qed
lemma OclNotEmpty_has_elt' : "τ ⊨ δ X ⟹
τ ⊨ X->notEmpty⇩B⇩a⇩g() ⟹
∃e. e ∈ (Rep_Set_base X τ)"
apply(drule OclNotEmpty_has_elt, simp)
by(simp add: Rep_Bag_base_def Rep_Set_base_def image_def)
text‹OclANY›
lemma OclANY_defined_args_valid: "τ ⊨ δ (X->any⇩B⇩a⇩g()) ⟹ τ ⊨ δ X"
by(auto simp: OclANY_def OclValid_def true_def valid_def false_def StrongEq_def
defined_def invalid_def bot_fun_def null_fun_def OclAnd_def
split: bool.split_asm HOL.if_split_asm option.split)
lemma "τ ⊨ δ X ⟹ τ ⊨ X->isEmpty⇩B⇩a⇩g() ⟹ ¬ τ ⊨ δ (X->any⇩B⇩a⇩g())"
apply(simp add: OclANY_def OclValid_def)
apply(subst cp_defined, subst cp_OclAnd, simp add: OclNotEmpty_def, subst (1 2) cp_OclNot,
simp add: cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_defined[symmetric],
simp add: false_def true_def)
by(drule foundation20[simplified OclValid_def true_def], simp)
lemma OclANY_valid_args_valid:
"(τ ⊨ υ(X->any⇩B⇩a⇩g())) = (τ ⊨ υ X)"
proof -
have A: "(τ ⊨ υ(X->any⇩B⇩a⇩g())) ⟹ ((τ ⊨(υ X)))"
by(auto simp: OclANY_def OclValid_def true_def valid_def false_def StrongEq_def
defined_def invalid_def bot_fun_def null_fun_def
split: bool.split_asm HOL.if_split_asm option.split)
have B: "(τ ⊨(υ X)) ⟹ (τ ⊨ υ(X->any⇩B⇩a⇩g()))"
apply(auto simp: OclANY_def OclValid_def true_def false_def StrongEq_def
defined_def invalid_def valid_def bot_fun_def null_fun_def
bot_option_def null_option_def null_is_valid
OclAnd_def
split: bool.split_asm HOL.if_split_asm option.split)
apply(frule Bag_inv_lemma[OF foundation16[THEN iffD2], OF conjI], simp)
apply(subgoal_tac "(δ X) τ = true τ")
prefer 2
apply (metis (hide_lams, no_types) OclValid_def foundation16)
apply(simp add: true_def,
drule OclNotEmpty_has_elt'[simplified OclValid_def true_def], simp)
apply(erule exE,
rule someI2[where Q = "λx. x ≠ ⊥" and P = "λy. y ∈ (Rep_Set_base X τ)",
simplified not_def, THEN mp], simp, auto)
by(simp add: Rep_Set_base_def image_def)
show ?thesis by(auto dest:A intro:B)
qed
lemma OclANY_valid_args_valid''[simp,code_unfold]:
"υ(X->any⇩B⇩a⇩g()) = (υ X)"
by(auto intro!: OclANY_valid_args_valid transform2_rev)
text_raw‹\endisatagafp›
subsection‹Execution Laws with Invalid or Null or Infinite Set as Argument›
text‹OclIncluding›
text‹OclExcluding›
text‹OclIncludes›
text‹OclExcludes›
text‹OclSize›
lemma OclSize_invalid[simp,code_unfold]:"(invalid->size⇩B⇩a⇩g()) = invalid"
by(simp add: bot_fun_def OclSize_def invalid_def defined_def valid_def false_def true_def)
lemma OclSize_null[simp,code_unfold]:"(null->size⇩B⇩a⇩g()) = invalid"
by(rule ext,
simp add: bot_fun_def null_fun_def null_is_valid OclSize_def
invalid_def defined_def valid_def false_def true_def)
text‹OclIsEmpty›
lemma OclIsEmpty_invalid[simp,code_unfold]:"(invalid->isEmpty⇩B⇩a⇩g()) = invalid"
by(simp add: OclIsEmpty_def)
lemma OclIsEmpty_null[simp,code_unfold]:"(null->isEmpty⇩B⇩a⇩g()) = true"
by(simp add: OclIsEmpty_def)
text‹OclNotEmpty›
lemma OclNotEmpty_invalid[simp,code_unfold]:"(invalid->notEmpty⇩B⇩a⇩g()) = invalid"
by(simp add: OclNotEmpty_def)
lemma OclNotEmpty_null[simp,code_unfold]:"(null->notEmpty⇩B⇩a⇩g()) = false"
by(simp add: OclNotEmpty_def)
text‹OclANY›
lemma OclANY_invalid[simp,code_unfold]:"(invalid->any⇩B⇩a⇩g()) = invalid"
by(simp add: bot_fun_def OclANY_def invalid_def defined_def valid_def false_def true_def)
lemma OclANY_null[simp,code_unfold]:"(null->any⇩B⇩a⇩g()) = null"
by(simp add: OclANY_def false_def true_def)
text‹OclForall›
lemma OclForall_invalid[simp,code_unfold]:"invalid->forAll⇩B⇩a⇩g(a| P a) = invalid"
by(simp add: bot_fun_def invalid_def OclForall_def defined_def valid_def false_def true_def)
lemma OclForall_null[simp,code_unfold]:"null->forAll⇩B⇩a⇩g(a | P a) = invalid"
by(simp add: bot_fun_def invalid_def OclForall_def defined_def valid_def false_def true_def)
text‹OclExists›
lemma OclExists_invalid[simp,code_unfold]:"invalid->exists⇩B⇩a⇩g(a| P a) = invalid"
by(simp add: OclExists_def)
lemma OclExists_null[simp,code_unfold]:"null->exists⇩B⇩a⇩g(a | P a) = invalid"
by(simp add: OclExists_def)
text‹OclIterate›
lemma OclIterate_invalid[simp,code_unfold]:"invalid->iterate⇩B⇩a⇩g(a; x = A | P a x) = invalid"
by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def)
lemma OclIterate_null[simp,code_unfold]:"null->iterate⇩B⇩a⇩g(a; x = A | P a x) = invalid"
by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def)
lemma OclIterate_invalid_args[simp,code_unfold]:"S->iterate⇩B⇩a⇩g(a; x = invalid | P a x) = invalid"
by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def)
text‹An open question is this ...›
lemma "S->iterate⇩B⇩a⇩g(a; x = null | P a x) = invalid"
oops
lemma OclIterate_infinite:
assumes non_finite: "τ ⊨ not(δ(S->size⇩B⇩a⇩g()))"
shows "(OclIterate S A F) τ = invalid τ"
apply(insert non_finite [THEN OclSize_infinite])
apply(subst (asm) foundation9, simp)
by(metis OclIterate_def OclValid_def invalid_def)
text‹OclSelect›
lemma OclSelect_invalid[simp,code_unfold]:"invalid->select⇩B⇩a⇩g(a | P a) = invalid"
by(simp add: bot_fun_def invalid_def OclSelect_def defined_def valid_def false_def true_def)
lemma OclSelect_null[simp,code_unfold]:"null->select⇩B⇩a⇩g(a | P a) = invalid"
by(simp add: bot_fun_def invalid_def OclSelect_def defined_def valid_def false_def true_def)
text‹OclReject›
lemma OclReject_invalid[simp,code_unfold]:"invalid->reject⇩B⇩a⇩g(a | P a) = invalid"
by(simp add: OclReject_def)
lemma OclReject_null[simp,code_unfold]:"null->reject⇩B⇩a⇩g(a | P a) = invalid"
by(simp add: OclReject_def)
text_raw‹\isatagafp›
subsubsection‹Context Passing›
lemma cp_OclIncludes1:
"(X->includes⇩B⇩a⇩g(x)) τ = (X->includes⇩B⇩a⇩g(λ _. x τ)) τ"
by(auto simp: OclIncludes_def StrongEq_def invalid_def
cp_defined[symmetric] cp_valid[symmetric])
lemma cp_OclSize: "X->size⇩B⇩a⇩g() τ = ((λ_. X τ)->size⇩B⇩a⇩g()) τ"
by(simp add: OclSize_def cp_defined[symmetric] Rep_Bag_base_def)
lemma cp_OclIsEmpty: "X->isEmpty⇩B⇩a⇩g() τ = ((λ_. X τ)->isEmpty⇩B⇩a⇩g()) τ"
apply(simp only: OclIsEmpty_def)
apply(subst (2) cp_OclOr,
subst cp_OclAnd,
subst cp_OclNot,
subst StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.cp0)
by(simp add: cp_defined[symmetric] cp_valid[symmetric] StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.cp0[symmetric]
cp_OclSize[symmetric] cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric])
lemma cp_OclNotEmpty: "X->notEmpty⇩B⇩a⇩g() τ = ((λ_. X τ)->notEmpty⇩B⇩a⇩g()) τ"
apply(simp only: OclNotEmpty_def)
apply(subst (2) cp_OclNot)
by(simp add: cp_OclNot[symmetric] cp_OclIsEmpty[symmetric])
lemma cp_OclANY: "X->any⇩B⇩a⇩g() τ = ((λ_. X τ)->any⇩B⇩a⇩g()) τ"
apply(simp only: OclANY_def)
apply(subst (2) cp_OclAnd)
by(simp only: cp_OclAnd[symmetric] cp_defined[symmetric] cp_valid[symmetric]
cp_OclNotEmpty[symmetric] Rep_Set_base_def)
lemma cp_OclForall:
"(S->forAll⇩B⇩a⇩g(x | P x)) τ = ((λ _. S τ)->forAll⇩B⇩a⇩g(x | P (λ _. x τ))) τ"
by(auto simp add: OclForall_def cp_defined[symmetric] Rep_Set_base_def)
lemma cp_OclForall1 [simp,intro!]:
"cp S ⟹ cp (λX. ((S X)->forAll⇩B⇩a⇩g(x | P x)))"
apply(simp add: cp_def)
apply(erule exE, rule exI, intro allI)
apply(erule_tac x=X in allE)
by(subst cp_OclForall, simp)
lemma
"cp (λX St x. P (λτ. x) X St) ⟹ cp S ⟹ cp (λX. (S X)->forAll⇩B⇩a⇩g(x|P x X)) "
apply(simp only: cp_def)
oops
lemma
"cp S ⟹
(⋀ x. cp(P x)) ⟹
cp(λX. ((S X)->forAll⇩B⇩a⇩g(x | P x X)))"
oops
lemma cp_OclExists:
"(S->exists⇩B⇩a⇩g(x | P x)) τ = ((λ _. S τ)->exists⇩B⇩a⇩g(x | P (λ _. x τ))) τ"
by(simp add: OclExists_def OclNot_def, subst cp_OclForall, simp)
lemma cp_OclExists1 [simp,intro!]:
"cp S ⟹ cp (λX. ((S X)->exists⇩B⇩a⇩g(x | P x)))"
apply(simp add: cp_def)
apply(erule exE, rule exI, intro allI)
apply(erule_tac x=X in allE)
by(subst cp_OclExists,simp)
lemma cp_OclIterate:
"(X->iterate⇩B⇩a⇩g(a; x = A | P a x)) τ =
((λ _. X τ)->iterate⇩B⇩a⇩g(a; x = A | P a x)) τ"
by(simp add: OclIterate_def cp_defined[symmetric] Rep_Bag_base_def)
lemma cp_OclSelect: "(X->select⇩B⇩a⇩g(a | P a)) τ =
((λ _. X τ)->select⇩B⇩a⇩g(a | P a)) τ"
by(simp add: OclSelect_def cp_defined[symmetric] Rep_Set_base_def)
lemma cp_OclReject: "(X->reject⇩B⇩a⇩g(a | P a)) τ = ((λ _. X τ)->reject⇩B⇩a⇩g(a | P a)) τ"
by(simp add: OclReject_def, subst cp_OclSelect, simp)
lemmas cp_intro''⇩B⇩a⇩g[intro!,simp,code_unfold] =
cp_OclSize [THEN allI[THEN allI[THEN cpI1], of "OclSize"]]
cp_OclIsEmpty [THEN allI[THEN allI[THEN cpI1], of "OclIsEmpty"]]
cp_OclNotEmpty [THEN allI[THEN allI[THEN cpI1], of "OclNotEmpty"]]
cp_OclANY [THEN allI[THEN allI[THEN cpI1], of "OclANY"]]
subsubsection‹Const›
lemma const_OclIncluding[simp,code_unfold] :
assumes const_x : "const x"
and const_S : "const S"
shows "const (S->including⇩B⇩a⇩g(x))"
proof -
have A:"⋀τ τ'. ¬ (τ ⊨ υ x) ⟹ (S->including⇩B⇩a⇩g(x) τ) = (S->including⇩B⇩a⇩g(x) τ')"
apply(simp add: foundation18)
apply(erule const_subst[OF const_x const_invalid],simp_all)
by(rule const_charn[OF const_invalid])
have B: "⋀ τ τ'. ¬ (τ ⊨ δ S) ⟹ (S->including⇩B⇩a⇩g(x) τ) = (S->including⇩B⇩a⇩g(x) τ')"
apply(simp add: foundation16', elim disjE)
apply(erule const_subst[OF const_S const_invalid],simp_all)
apply(rule const_charn[OF const_invalid])
apply(erule const_subst[OF const_S const_null],simp_all)
by(rule const_charn[OF const_invalid])
show ?thesis
apply(simp only: const_def,intro allI, rename_tac τ τ')
apply(case_tac "¬ (τ ⊨ υ x)", simp add: A)
apply(case_tac "¬ (τ ⊨ δ S)", simp_all add: B)
apply(frule_tac τ'1= τ' in const_OclValid2[OF const_x, THEN iffD1])
apply(frule_tac τ'1= τ' in const_OclValid1[OF const_S, THEN iffD1])
apply(simp add: OclIncluding_def OclValid_def)
apply(subst (1 2) const_charn[OF const_x])
apply(subst (1 2) const_charn[OF const_S])
by simp
qed
text_raw‹\endisatagafp›
subsection‹Test Statements›
instantiation Bag⇩b⇩a⇩s⇩e :: (equal)equal
begin
definition "HOL.equal k l ⟷ (k::('a::equal)Bag⇩b⇩a⇩s⇩e) = l"
instance by standard (rule equal_Bag⇩b⇩a⇩s⇩e_def)
end
lemma equal_Bag⇩b⇩a⇩s⇩e_code [code]:
"HOL.equal k (l::('a::{equal,null})Bag⇩b⇩a⇩s⇩e) ⟷ Rep_Bag⇩b⇩a⇩s⇩e k = Rep_Bag⇩b⇩a⇩s⇩e l"
by (auto simp add: equal Bag⇩b⇩a⇩s⇩e.Rep_Bag⇩b⇩a⇩s⇩e_inject)
Assert "τ ⊨ (Bag{} ≐ Bag{})"
end
Theory UML_Set
theory UML_Set
imports "../basic_types/UML_Void"
"../basic_types/UML_Boolean"
"../basic_types/UML_Integer"
"../basic_types/UML_String"
"../basic_types/UML_Real"
begin
no_notation None ("⊥")
section‹Collection Type Set: Operations \label{formal-set}›
subsection‹As a Motivation for the (infinite) Type Construction: Type-Extensions as Sets
\label{sec:type-extensions}›
text‹Our notion of typed set goes beyond the usual notion of a finite executable set and
is powerful enough to capture \emph{the extension of a type} in UML and OCL. This means
we can have in Featherweight OCL Sets containing all possible elements of a type, not only
those (finite) ones representable in a state. This holds for base types as well as class types,
although the notion for class-types --- involving object id's not occurring in a state ---
requires some care.
In a world with @{term invalid} and @{term null}, there are two notions extensions possible:
\begin{enumerate}
\item the set of all \emph{defined} values of a type @{term T}
(for which we will introduce the constant @{term T})
\item the set of all \emph{valid} values of a type @{term T}, so including @{term null}
(for which we will introduce the constant @{term T⇩n⇩u⇩l⇩l}).
\end{enumerate}
›
text‹We define the set extensions for the base type @{term Integer} as follows:›
definition Integer :: "('𝔄,Integer⇩b⇩a⇩s⇩e) Set"
where "Integer ≡ (λ τ. (Abs_Set⇩b⇩a⇩s⇩e o Some o Some) ((Some o Some) ` (UNIV::int set)))"
definition Integer⇩n⇩u⇩l⇩l :: "('𝔄,Integer⇩b⇩a⇩s⇩e) Set"
where "Integer⇩n⇩u⇩l⇩l ≡ (λ τ. (Abs_Set⇩b⇩a⇩s⇩e o Some o Some) (Some ` (UNIV::int option set)))"
lemma Integer_defined : "δ Integer = true"
apply(rule ext, auto simp: Integer_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def null_option_def)
lemma Integer⇩n⇩u⇩l⇩l_defined : "δ Integer⇩n⇩u⇩l⇩l = true"
apply(rule ext, auto simp: Integer⇩n⇩u⇩l⇩l_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def null_option_def)
text‹This allows the theorems:
‹τ ⊨ δ x ⟹ τ ⊨ (Integer->includes⇩S⇩e⇩t(x))›
‹τ ⊨ δ x ⟹ τ ⊨ Integer ≜ (Integer->including⇩S⇩e⇩t(x))›
and
‹τ ⊨ υ x ⟹ τ ⊨ (Integer⇩n⇩u⇩l⇩l->includes⇩S⇩e⇩t(x))›
‹τ ⊨ υ x ⟹ τ ⊨ Integer⇩n⇩u⇩l⇩l ≜ (Integer⇩n⇩u⇩l⇩l->including⇩S⇩e⇩t(x))›
which characterize the infiniteness of these sets by a recursive property on these sets.
›
text‹In the same spirit, we proceed similarly for the remaining base types:›
definition Void⇩n⇩u⇩l⇩l :: "('𝔄,Void⇩b⇩a⇩s⇩e) Set"
where "Void⇩n⇩u⇩l⇩l ≡ (λ τ. (Abs_Set⇩b⇩a⇩s⇩e o Some o Some) {Abs_Void⇩b⇩a⇩s⇩e (Some None)})"
definition Void⇩e⇩m⇩p⇩t⇩y :: "('𝔄,Void⇩b⇩a⇩s⇩e) Set"
where "Void⇩e⇩m⇩p⇩t⇩y ≡ (λ τ. (Abs_Set⇩b⇩a⇩s⇩e o Some o Some) {})"
lemma Void⇩n⇩u⇩l⇩l_defined : "δ Void⇩n⇩u⇩l⇩l = true"
apply(rule ext, auto simp: Void⇩n⇩u⇩l⇩l_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def
bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def)
by((subst (asm) Abs_Set⇩b⇩a⇩s⇩e_inject, auto simp add: bot_option_def null_option_def bot_Void_def),
(subst (asm) Abs_Void⇩b⇩a⇩s⇩e_inject, auto simp add: bot_option_def null_option_def))+
lemma Void⇩e⇩m⇩p⇩t⇩y_defined : "δ Void⇩e⇩m⇩p⇩t⇩y = true"
apply(rule ext, auto simp: Void⇩e⇩m⇩p⇩t⇩y_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def
bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def)
by((subst (asm) Abs_Set⇩b⇩a⇩s⇩e_inject, auto simp add: bot_option_def null_option_def bot_Void_def))+
lemma assumes "τ ⊨ δ (V :: ('𝔄,Void⇩b⇩a⇩s⇩e) Set)"
shows "τ ⊨ V ≜ Void⇩n⇩u⇩l⇩l ∨ τ ⊨ V ≜ Void⇩e⇩m⇩p⇩t⇩y"
proof -
have A:"⋀x y. x ≠ {} ⟹ ∃y. y∈ x"
by (metis all_not_in_conv)
show "?thesis"
apply(case_tac "V τ")
proof - fix y show "V τ = Abs_Set⇩b⇩a⇩s⇩e y ⟹
y ∈ {X. X = ⊥ ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ ⊥)} ⟹
τ ⊨ V ≜ Void⇩n⇩u⇩l⇩l ∨ τ ⊨ V ≜ Void⇩e⇩m⇩p⇩t⇩y"
apply(insert assms, case_tac y, simp add: bot_option_def, simp add: bot_Set⇩b⇩a⇩s⇩e_def foundation16)
apply(simp add: bot_option_def null_option_def)
apply(erule disjE, metis OclValid_def defined_def foundation2 null_Set⇩b⇩a⇩s⇩e_def null_fun_def true_def)
proof - fix a show "V τ = Abs_Set⇩b⇩a⇩s⇩e ⌊a⌋ ⟹ ∀x∈⌈a⌉. x ≠ ⊥ ⟹ τ ⊨ V ≜ Void⇩n⇩u⇩l⇩l ∨ τ ⊨ V ≜ Void⇩e⇩m⇩p⇩t⇩y"
apply(case_tac a, simp, insert assms, metis OclValid_def foundation16 null_Set⇩b⇩a⇩s⇩e_def true_def)
apply(simp)
proof - fix aa show " V τ = Abs_Set⇩b⇩a⇩s⇩e ⌊⌊aa⌋⌋ ⟹ ∀x∈aa. x ≠ ⊥ ⟹ τ ⊨ V ≜ Void⇩n⇩u⇩l⇩l ∨ τ ⊨ V ≜ Void⇩e⇩m⇩p⇩t⇩y"
apply(case_tac "aa = {}",
rule disjI2,
insert assms,
simp add: Void⇩e⇩m⇩p⇩t⇩y_def OclValid_def StrongEq_def true_def,
rule disjI1)
apply(subgoal_tac "aa = {Abs_Void⇩b⇩a⇩s⇩e ⌊None⌋}", simp add: StrongEq_def OclValid_def true_def Void⇩n⇩u⇩l⇩l_def)
apply(drule A, erule exE)
proof - fix y show "V τ = Abs_Set⇩b⇩a⇩s⇩e ⌊⌊aa⌋⌋ ⟹
∀x∈aa. x ≠ ⊥ ⟹
τ ⊨ δ V ⟹
y ∈ aa ⟹
aa = {Abs_Void⇩b⇩a⇩s⇩e ⌊None⌋}"
apply(rule equalityI, rule subsetI, simp)
proof - fix x show " V τ = Abs_Set⇩b⇩a⇩s⇩e ⌊⌊aa⌋⌋ ⟹
∀x∈aa. x ≠ ⊥ ⟹ τ ⊨ δ V ⟹ y ∈ aa ⟹ x ∈ aa ⟹ x = Abs_Void⇩b⇩a⇩s⇩e ⌊None⌋"
apply(case_tac x, simp)
by (metis bot_Void_def bot_option_def null_option_def)
apply_end(simp_all)
apply_end(erule ballE[where x = y], simp_all)
apply_end(case_tac y,
simp add: bot_option_def null_option_def OclValid_def defined_def split: if_split_asm,
simp add: false_def true_def)
qed (erule disjE, simp add: bot_Void_def, simp)
qed qed qed qed qed
definition Boolean :: "('𝔄,Boolean⇩b⇩a⇩s⇩e) Set"
where "Boolean ≡ (λ τ. (Abs_Set⇩b⇩a⇩s⇩e o Some o Some) ((Some o Some) ` (UNIV::bool set)))"
definition Boolean⇩n⇩u⇩l⇩l :: "('𝔄,Boolean⇩b⇩a⇩s⇩e) Set"
where "Boolean⇩n⇩u⇩l⇩l ≡ (λ τ. (Abs_Set⇩b⇩a⇩s⇩e o Some o Some) (Some ` (UNIV::bool option set)))"
lemma Boolean_defined : "δ Boolean = true"
apply(rule ext, auto simp: Boolean_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def null_option_def)
lemma Boolean⇩n⇩u⇩l⇩l_defined : "δ Boolean⇩n⇩u⇩l⇩l = true"
apply(rule ext, auto simp: Boolean⇩n⇩u⇩l⇩l_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def null_option_def)
definition String :: "('𝔄,String⇩b⇩a⇩s⇩e) Set"
where "String ≡ (λ τ. (Abs_Set⇩b⇩a⇩s⇩e o Some o Some) ((Some o Some) ` (UNIV::string set)))"
definition String⇩n⇩u⇩l⇩l :: "('𝔄,String⇩b⇩a⇩s⇩e) Set"
where "String⇩n⇩u⇩l⇩l ≡ (λ τ. (Abs_Set⇩b⇩a⇩s⇩e o Some o Some) (Some ` (UNIV::string option set)))"
lemma String_defined : "δ String = true"
apply(rule ext, auto simp: String_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def null_option_def)
lemma String⇩n⇩u⇩l⇩l_defined : "δ String⇩n⇩u⇩l⇩l = true"
apply(rule ext, auto simp: String⇩n⇩u⇩l⇩l_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def null_option_def)
definition Real :: "('𝔄,Real⇩b⇩a⇩s⇩e) Set"
where "Real ≡ (λ τ. (Abs_Set⇩b⇩a⇩s⇩e o Some o Some) ((Some o Some) ` (UNIV::real set)))"
definition Real⇩n⇩u⇩l⇩l :: "('𝔄,Real⇩b⇩a⇩s⇩e) Set"
where "Real⇩n⇩u⇩l⇩l ≡ (λ τ. (Abs_Set⇩b⇩a⇩s⇩e o Some o Some) (Some ` (UNIV::real option set)))"
lemma Real_defined : "δ Real = true"
apply(rule ext, auto simp: Real_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def null_option_def)
lemma Real⇩n⇩u⇩l⇩l_defined : "δ Real⇩n⇩u⇩l⇩l = true"
apply(rule ext, auto simp: Real⇩n⇩u⇩l⇩l_def defined_def false_def true_def
bot_fun_def null_fun_def null_option_def)
by(simp_all add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def null_option_def)
subsection‹Basic Properties of the Set Type›
text‹Every element in a defined set is valid.›
lemma Set_inv_lemma: "τ ⊨ (δ X) ⟹ ∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. x ≠ bot"
apply(insert Rep_Set⇩b⇩a⇩s⇩e [of "X τ"], simp)
apply(auto simp: OclValid_def defined_def false_def true_def cp_def
bot_fun_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def null_fun_def
split:if_split_asm)
apply(erule contrapos_pp [of "Rep_Set⇩b⇩a⇩s⇩e (X τ) = bot"])
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inject[symmetric], rule Rep_Set⇩b⇩a⇩s⇩e, simp)
apply(simp add: Rep_Set⇩b⇩a⇩s⇩e_inverse bot_Set⇩b⇩a⇩s⇩e_def bot_option_def)
apply(erule contrapos_pp [of "Rep_Set⇩b⇩a⇩s⇩e (X τ) = null"])
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inject[symmetric], rule Rep_Set⇩b⇩a⇩s⇩e, simp)
apply(simp add: Rep_Set⇩b⇩a⇩s⇩e_inverse null_option_def)
by (simp add: bot_option_def)
lemma Set_inv_lemma' :
assumes x_def : "τ ⊨ δ X"
and e_mem : "e ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
shows "τ ⊨ υ (λ_. e)"
apply(rule Set_inv_lemma[OF x_def, THEN ballE[where x = e]])
apply(simp add: foundation18')
by(simp add: e_mem)
lemma abs_rep_simp' :
assumes S_all_def : "τ ⊨ δ S"
shows "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉⌋⌋ = S τ"
proof -
have discr_eq_false_true : "⋀τ. (false τ = true τ) = False" by(simp add: false_def true_def)
show ?thesis
apply(insert S_all_def, simp add: OclValid_def defined_def)
apply(rule mp[OF Abs_Set⇩b⇩a⇩s⇩e_induct[where P = "λS. (if S = ⊥ τ ∨ S = null τ
then false τ else true τ) = true τ ⟶
Abs_Set⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e S⌉⌉⌋⌋ = S"]],
rename_tac S')
apply(simp add: Abs_Set⇩b⇩a⇩s⇩e_inverse discr_eq_false_true)
apply(case_tac S') apply(simp add: bot_fun_def bot_Set⇩b⇩a⇩s⇩e_def)+
apply(rename_tac S'', case_tac S'') apply(simp add: null_fun_def null_Set⇩b⇩a⇩s⇩e_def)+
done
qed
lemma S_lift' :
assumes S_all_def : "(τ :: '𝔄 st) ⊨ δ S"
shows "∃S'. (λa (_::'𝔄 st). a) ` ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ = (λa (_::'𝔄 st). ⌊a⌋) ` S'"
apply(rule_tac x = "(λa. ⌈a⌉) ` ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉" in exI)
apply(simp only: image_comp)
apply(simp add: comp_def)
apply(rule image_cong, fast)
apply(drule Set_inv_lemma'[OF S_all_def])
by(case_tac x, (simp add: bot_option_def foundation18')+)
lemma invalid_set_OclNot_defined [simp,code_unfold]:"δ(invalid::('𝔄,'α::null) Set) = false" by simp
lemma null_set_OclNot_defined [simp,code_unfold]:"δ(null::('𝔄,'α::null) Set) = false"
by(simp add: defined_def null_fun_def)
lemma invalid_set_valid [simp,code_unfold]:"υ(invalid::('𝔄,'α::null) Set) = false"
by simp
lemma null_set_valid [simp,code_unfold]:"υ(null::('𝔄,'α::null) Set) = true"
apply(simp add: valid_def null_fun_def bot_fun_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inject,simp_all add: null_option_def bot_option_def)
done
text‹... which means that we can have a type ‹('𝔄,('𝔄,('𝔄) Integer) Set) Set›
corresponding exactly to Set(Set(Integer)) in OCL notation. Note that the parameter
‹'𝔄› still refers to the object universe; making the OCL semantics entirely parametric
in the object universe makes it possible to study (and prove) its properties
independently from a concrete class diagram.›
subsection‹Definition: Strict Equality \label{sec:set-strict-equality}›
text‹After the part of foundational operations on sets, we detail here equality on sets.
Strong equality is inherited from the OCL core, but we have to consider
the case of the strict equality. We decide to overload strict equality in the
same way we do for other value's in OCL:›
overloading
StrictRefEq ≡ "StrictRefEq :: [('𝔄,'α::null)Set,('𝔄,'α::null)Set] ⇒ ('𝔄)Boolean"
begin
definition StrictRefEq⇩S⇩e⇩t :
"(x::('𝔄,'α::null)Set) ≐ y ≡ λ τ. if (υ x) τ = true τ ∧ (υ y) τ = true τ
then (x ≜ y)τ
else invalid τ"
end
text‹One might object here that for the case of objects, this is an empty definition.
The answer is no, we will restrain later on states and objects such that any object
has its oid stored inside the object (so the ref, under which an object can be referenced
in the store will represented in the object itself). For such well-formed stores that satisfy
this invariant (the WFF-invariant), the referential equality and the
strong equality---and therefore the strict equality on sets in the sense above---coincides.›
text‹Property proof in terms of @{term "profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v"}›
interpretation StrictRefEq⇩S⇩e⇩t : profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v "λ x y. (x::('𝔄,'α::null)Set) ≐ y"
by unfold_locales (auto simp: StrictRefEq⇩S⇩e⇩t)
subsection‹Constants: mtSet›
definition mtSet::"('𝔄,'α::null) Set" ("Set{}")
where "Set{} ≡ (λ τ. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊{}::'α set⌋⌋ )"
lemma mtSet_defined[simp,code_unfold]:"δ(Set{}) = true"
apply(rule ext, auto simp: mtSet_def defined_def null_Set⇩b⇩a⇩s⇩e_def
bot_Set⇩b⇩a⇩s⇩e_def bot_fun_def null_fun_def)
by(simp_all add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_Set⇩b⇩a⇩s⇩e_def null_option_def)
lemma mtSet_valid[simp,code_unfold]:"υ(Set{}) = true"
apply(rule ext,auto simp: mtSet_def valid_def null_Set⇩b⇩a⇩s⇩e_def
bot_Set⇩b⇩a⇩s⇩e_def bot_fun_def null_fun_def)
by(simp_all add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_Set⇩b⇩a⇩s⇩e_def null_option_def)
lemma mtSet_rep_set: "⌈⌈Rep_Set⇩b⇩a⇩s⇩e (Set{} τ)⌉⌉ = {}"
apply(simp add: mtSet_def, subst Abs_Set⇩b⇩a⇩s⇩e_inverse)
by(simp add: bot_option_def)+
lemma [simp,code_unfold]: "const Set{}"
by(simp add: const_def mtSet_def)
text‹Note that the collection types in OCL allow for null to be included;
however, there is the null-collection into which inclusion yields invalid.›
subsection‹Definition: Including›
definition OclIncluding :: "[('𝔄,'α::null) Set,('𝔄,'α) val] ⇒ ('𝔄,'α) Set"
where "OclIncluding x y = (λ τ. if (δ x) τ = true τ ∧ (υ y) τ = true τ
then Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (x τ)⌉⌉ ∪ {y τ} ⌋⌋
else invalid τ )"
notation OclIncluding ("_->including⇩S⇩e⇩t'(_')")
interpretation OclIncluding : profile_bin⇩d_⇩v OclIncluding "λx y. Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉ ∪ {y}⌋⌋"
proof -
have A : "None ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}" by(simp add: bot_option_def)
have B : "⌊None⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(simp add: null_option_def bot_option_def)
have C : "⋀x y. x ≠ ⊥ ⟹ x ≠ null ⟹ y ≠ ⊥ ⟹
⌊⌊insert y ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(auto intro!:Set_inv_lemma[simplified OclValid_def
defined_def false_def true_def null_fun_def bot_fun_def])
show "profile_bin⇩d_⇩v OclIncluding (λx y. Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉ ∪ {y}⌋⌋)"
apply unfold_locales
apply(auto simp:OclIncluding_def bot_option_def null_option_def null_Set⇩b⇩a⇩s⇩e_def bot_Set⇩b⇩a⇩s⇩e_def)
apply(erule_tac Q="Abs_Set⇩b⇩a⇩s⇩e⌊⌊insert y ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋ = Abs_Set⇩b⇩a⇩s⇩e None" in contrapos_pp)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inject[OF C A])
apply(simp_all add: null_Set⇩b⇩a⇩s⇩e_def bot_Set⇩b⇩a⇩s⇩e_def bot_option_def)
apply(erule_tac Q="Abs_Set⇩b⇩a⇩s⇩e⌊⌊insert y ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋ = Abs_Set⇩b⇩a⇩s⇩e ⌊None⌋" in contrapos_pp)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inject[OF C B])
apply(simp_all add: null_Set⇩b⇩a⇩s⇩e_def bot_Set⇩b⇩a⇩s⇩e_def bot_option_def)
done
qed
syntax
"_OclFinset" :: "args => ('𝔄,'a::null) Set" ("Set{(_)}")
translations
"Set{x, xs}" == "CONST OclIncluding (Set{xs}) x"
"Set{x}" == "CONST OclIncluding (Set{}) x "
subsection‹Definition: Excluding›
definition OclExcluding :: "[('𝔄,'α::null) Set,('𝔄,'α) val] ⇒ ('𝔄,'α) Set"
where "OclExcluding x y = (λ τ. if (δ x) τ = true τ ∧ (υ y) τ = true τ
then Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (x τ)⌉⌉ - {y τ} ⌋⌋
else ⊥ )"
notation OclExcluding ("_->excluding⇩S⇩e⇩t'(_')")
lemma OclExcluding_inv: "(x:: Set('b::{null})) ≠ ⊥ ⟹ x ≠ null ⟹ y ≠ ⊥ ⟹
⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉ - {y}⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
proof - fix X :: "'a state × 'a state ⇒ Set('b)" fix τ
show "x ≠ ⊥ ⟹ x ≠ null ⟹ y ≠ ⊥ ⟹ ?thesis"
when "x = X τ"
by(simp add: that Set_inv_lemma[simplified OclValid_def
defined_def null_fun_def bot_fun_def, of X τ])
qed simp_all
interpretation OclExcluding : profile_bin⇩d_⇩v OclExcluding "λx y. Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉ - {y}⌋⌋"
proof -
have A : "None ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}" by(simp add: bot_option_def)
have B : "⌊None⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(simp add: null_option_def bot_option_def)
show "profile_bin⇩d_⇩v OclExcluding (λx y. Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (x:: Set('b))⌉⌉ - {y}⌋⌋)"
apply unfold_locales
apply(auto simp:OclExcluding_def bot_option_def null_option_def null_Set⇩b⇩a⇩s⇩e_def bot_Set⇩b⇩a⇩s⇩e_def invalid_def)
apply(erule_tac Q="Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉ - {y}⌋⌋ = Abs_Set⇩b⇩a⇩s⇩e None" in contrapos_pp)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inject[OF OclExcluding_inv A])
apply(simp_all add: null_Set⇩b⇩a⇩s⇩e_def bot_Set⇩b⇩a⇩s⇩e_def bot_option_def)
apply(erule_tac Q="Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉ - {y}⌋⌋ = Abs_Set⇩b⇩a⇩s⇩e ⌊None⌋" in contrapos_pp)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inject[OF OclExcluding_inv B])
apply(simp_all add: null_Set⇩b⇩a⇩s⇩e_def bot_Set⇩b⇩a⇩s⇩e_def bot_option_def)
done
qed
subsection‹Definition: Includes›
definition OclIncludes :: "[('𝔄,'α::null) Set,('𝔄,'α) val] ⇒ '𝔄 Boolean"
where "OclIncludes x y = (λ τ. if (δ x) τ = true τ ∧ (υ y) τ = true τ
then ⌊⌊(y τ) ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (x τ)⌉⌉ ⌋⌋
else ⊥ )"
notation OclIncludes ("_->includes⇩S⇩e⇩t'(_')" )
interpretation OclIncludes : profile_bin⇩d_⇩v OclIncludes "λx y. ⌊⌊y ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋"
by(unfold_locales, auto simp:OclIncludes_def bot_option_def null_option_def invalid_def)
subsection‹Definition: Excludes›
definition OclExcludes :: "[('𝔄,'α::null) Set,('𝔄,'α) val] ⇒ '𝔄 Boolean"
where "OclExcludes x y = (not(OclIncludes x y))"
notation OclExcludes ("_->excludes⇩S⇩e⇩t'(_')" )
text‹The case of the size definition is somewhat special, we admit
explicitly in Featherweight OCL the possibility of infinite sets. For
the size definition, this requires an extra condition that assures
that the cardinality of the set is actually a defined integer.›
interpretation OclExcludes : profile_bin⇩d_⇩v OclExcludes "λx y. ⌊⌊y ∉ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋"
by(unfold_locales, auto simp:OclExcludes_def OclIncludes_def OclNot_def bot_option_def null_option_def invalid_def)
subsection‹Definition: Size›
definition OclSize :: "('𝔄,'α::null)Set ⇒ '𝔄 Integer"
where "OclSize x = (λ τ. if (δ x) τ = true τ ∧ finite(⌈⌈Rep_Set⇩b⇩a⇩s⇩e (x τ)⌉⌉)
then ⌊⌊ int(card ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (x τ)⌉⌉) ⌋⌋
else ⊥ )"
notation
OclSize ("_->size⇩S⇩e⇩t'(')" )
text‹The following definition follows the requirement of the
standard to treat null as neutral element of sets. It is
a well-documented exception from the general strictness
rule and the rule that the distinguished argument self should
be non-null.›
subsection‹Definition: IsEmpty›
definition OclIsEmpty :: "('𝔄,'α::null) Set ⇒ '𝔄 Boolean"
where "OclIsEmpty x = ((υ x and not (δ x)) or ((OclSize x) ≐ 𝟬))"
notation OclIsEmpty ("_->isEmpty⇩S⇩e⇩t'(')" )
subsection‹Definition: NotEmpty›
definition OclNotEmpty :: "('𝔄,'α::null) Set ⇒ '𝔄 Boolean"
where "OclNotEmpty x = not(OclIsEmpty x)"
notation OclNotEmpty ("_->notEmpty⇩S⇩e⇩t'(')" )
subsection‹Definition: Any›
definition OclANY :: "[('𝔄,'α::null) Set] ⇒ ('𝔄,'α) val"
where "OclANY x = (λ τ. if (υ x) τ = true τ
then if (δ x and OclNotEmpty x) τ = true τ
then SOME y. y ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (x τ)⌉⌉
else null τ
else ⊥ )"
notation OclANY ("_->any⇩S⇩e⇩t'(')")
subsection‹Definition: Forall›
text‹The definition of OclForall mimics the one of @{term "OclAnd"}:
OclForall is not a strict operation.›
definition OclForall :: "[('𝔄,'α::null)Set,('𝔄,'α)val⇒('𝔄)Boolean] ⇒ '𝔄 Boolean"
where "OclForall S P = (λ τ. if (δ S) τ = true τ
then if (∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉. P(λ _. x) τ = false τ)
then false τ
else if (∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉. P(λ _. x) τ = invalid τ)
then invalid τ
else if (∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉. P(λ _. x) τ = null τ)
then null τ
else true τ
else ⊥)"
syntax
"_OclForallSet" :: "[('𝔄,'α::null) Set,id,('𝔄)Boolean] ⇒ '𝔄 Boolean" ("(_)->forAll⇩S⇩e⇩t'(_|_')")
translations
"X->forAll⇩S⇩e⇩t(x | P)" == "CONST UML_Set.OclForall X (%x. P)"
subsection‹Definition: Exists›
text‹Like OclForall, OclExists is also not strict.›
definition OclExists :: "[('𝔄,'α::null) Set,('𝔄,'α)val⇒('𝔄)Boolean] ⇒ '𝔄 Boolean"
where "OclExists S P = not(UML_Set.OclForall S (λ X. not (P X)))"
syntax
"_OclExistSet" :: "[('𝔄,'α::null) Set,id,('𝔄)Boolean] ⇒ '𝔄 Boolean" ("(_)->exists⇩S⇩e⇩t'(_|_')")
translations
"X->exists⇩S⇩e⇩t(x | P)" == "CONST UML_Set.OclExists X (%x. P)"
subsection‹Definition: Iterate›
definition OclIterate :: "[('𝔄,'α::null) Set,('𝔄,'β::null)val,
('𝔄,'α)val⇒('𝔄,'β)val⇒('𝔄,'β)val] ⇒ ('𝔄,'β)val"
where "OclIterate S A F = (λ τ. if (δ S) τ = true τ ∧ (υ A) τ = true τ ∧ finite⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉
then (Finite_Set.fold (F) (A) ((λa τ. a) ` ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉))τ
else ⊥)"
syntax
"_OclIterateSet" :: "[('𝔄,'α::null) Set, idt, idt, 'α, 'β] => ('𝔄,'γ)val"
("_ ->iterate⇩S⇩e⇩t'(_;_=_ | _')" )
translations
"X->iterate⇩S⇩e⇩t(a; x = A | P)" == "CONST OclIterate X A (%a. (% x. P))"
subsection‹Definition: Select›
definition OclSelect :: "[('𝔄,'α::null)Set,('𝔄,'α)val⇒('𝔄)Boolean] ⇒ ('𝔄,'α)Set"
where "OclSelect S P = (λτ. if (δ S) τ = true τ
then if (∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉. P(λ _. x) τ = invalid τ)
then invalid τ
else Abs_Set⇩b⇩a⇩s⇩e ⌊⌊{x∈⌈⌈ Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉. P (λ_. x) τ ≠ false τ}⌋⌋
else invalid τ)"
syntax
"_OclSelectSet" :: "[('𝔄,'α::null) Set,id,('𝔄)Boolean] ⇒ '𝔄 Boolean" ("(_)->select⇩S⇩e⇩t'(_|_')")
translations
"X->select⇩S⇩e⇩t(x | P)" == "CONST OclSelect X (% x. P)"
subsection‹Definition: Reject›
definition OclReject :: "[('𝔄,'α::null)Set,('𝔄,'α)val⇒('𝔄)Boolean] ⇒ ('𝔄,'α::null)Set"
where "OclReject S P = OclSelect S (not o P)"
syntax
"_OclRejectSet" :: "[('𝔄,'α::null) Set,id,('𝔄)Boolean] ⇒ '𝔄 Boolean" ("(_)->reject⇩S⇩e⇩t'(_|_')")
translations
"X->reject⇩S⇩e⇩t(x | P)" == "CONST OclReject X (% x. P)"
subsection‹Definition: IncludesAll›
definition OclIncludesAll :: "[('𝔄,'α::null) Set,('𝔄,'α) Set] ⇒ '𝔄 Boolean"
where "OclIncludesAll x y = (λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (y τ)⌉⌉ ⊆ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (x τ)⌉⌉ ⌋⌋
else ⊥ )"
notation OclIncludesAll ("_->includesAll⇩S⇩e⇩t'(_')" )
interpretation OclIncludesAll : profile_bin⇩d_⇩d OclIncludesAll "λx y. ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e y⌉⌉ ⊆ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋"
by(unfold_locales, auto simp:OclIncludesAll_def bot_option_def null_option_def invalid_def)
subsection‹Definition: ExcludesAll›
definition OclExcludesAll :: "[('𝔄,'α::null) Set,('𝔄,'α) Set] ⇒ '𝔄 Boolean"
where "OclExcludesAll x y = (λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (y τ)⌉⌉ ∩ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (x τ)⌉⌉ = {} ⌋⌋
else ⊥ )"
notation OclExcludesAll ("_->excludesAll⇩S⇩e⇩t'(_')" )
interpretation OclExcludesAll : profile_bin⇩d_⇩d OclExcludesAll "λx y. ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e y⌉⌉ ∩ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉ = {}⌋⌋"
by(unfold_locales, auto simp:OclExcludesAll_def bot_option_def null_option_def invalid_def)
subsection‹Definition: Union›
definition OclUnion :: "[('𝔄,'α::null) Set,('𝔄,'α) Set] ⇒ ('𝔄,'α) Set"
where "OclUnion x y = (λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (y τ)⌉⌉ ∪ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (x τ)⌉⌉ ⌋⌋
else ⊥ )"
notation OclUnion ("_->union⇩S⇩e⇩t'(_')" )
lemma OclUnion_inv: "(x:: Set('b::{null})) ≠ ⊥ ⟹ x ≠ null ⟹ y ≠ ⊥ ⟹ y ≠ null ⟹
⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e y⌉⌉ ∪ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
proof - fix X Y :: "'a state × 'a state ⇒ Set('b)" fix τ
show "x ≠ ⊥ ⟹ x ≠ null ⟹ y ≠ ⊥ ⟹ y ≠ null ⟹ ?thesis"
when "x = X τ" "y = Y τ"
by(auto simp: that,
insert
Set_inv_lemma[simplified OclValid_def
defined_def null_fun_def bot_fun_def, of Y τ]
Set_inv_lemma[simplified OclValid_def
defined_def null_fun_def bot_fun_def, of X τ],
auto)
qed simp_all
interpretation OclUnion : profile_bin⇩d_⇩d OclUnion "λx y. Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e y⌉⌉ ∪ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋"
proof -
have A : "None ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}" by(simp add: bot_option_def)
have B : "⌊None⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(simp add: null_option_def bot_option_def)
show "profile_bin⇩d_⇩d OclUnion (λx y. Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e y⌉⌉ ∪ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋)"
apply unfold_locales
apply(auto simp:OclUnion_def bot_option_def null_option_def null_Set⇩b⇩a⇩s⇩e_def bot_Set⇩b⇩a⇩s⇩e_def invalid_def)
apply(erule_tac Q="Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e y⌉⌉ ∪ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋ = Abs_Set⇩b⇩a⇩s⇩e None" in contrapos_pp)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inject[OF OclUnion_inv A])
apply(simp_all add: null_Set⇩b⇩a⇩s⇩e_def bot_Set⇩b⇩a⇩s⇩e_def bot_option_def)
apply(erule_tac Q="Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e y⌉⌉ ∪ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋ = Abs_Set⇩b⇩a⇩s⇩e ⌊None⌋" in contrapos_pp)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inject[OF OclUnion_inv B])
apply(simp_all add: null_Set⇩b⇩a⇩s⇩e_def bot_Set⇩b⇩a⇩s⇩e_def bot_option_def)
done
qed
subsection‹Definition: Intersection›
definition OclIntersection :: "[('𝔄,'α::null) Set,('𝔄,'α) Set] ⇒ ('𝔄,'α) Set"
where "OclIntersection x y = (λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (y τ)⌉⌉
∩ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (x τ)⌉⌉⌋⌋
else ⊥ )"
notation OclIntersection("_->intersection⇩S⇩e⇩t'(_')" )
lemma OclIntersection_inv: "(x:: Set('b::{null})) ≠ ⊥ ⟹ x ≠ null ⟹ y ≠ ⊥ ⟹ y ≠ null ⟹
⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e y⌉⌉ ∩ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
proof - fix X Y :: "'a state × 'a state ⇒ Set('b)" fix τ
show "x ≠ ⊥ ⟹ x ≠ null ⟹ y ≠ ⊥ ⟹ y ≠ null ⟹ ?thesis"
when "x = X τ" "y = Y τ"
by(auto simp: that,
insert
Set_inv_lemma[simplified OclValid_def
defined_def null_fun_def bot_fun_def, of Y τ]
Set_inv_lemma[simplified OclValid_def
defined_def null_fun_def bot_fun_def, of X τ],
auto)
qed simp_all
interpretation OclIntersection : profile_bin⇩d_⇩d OclIntersection "λx y. Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e y⌉⌉ ∩ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋"
proof -
have A : "None ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}" by(simp add: bot_option_def)
have B : "⌊None⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(simp add: null_option_def bot_option_def)
show "profile_bin⇩d_⇩d OclIntersection (λx y. Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e y⌉⌉ ∩ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋)"
apply unfold_locales
apply(auto simp:OclIntersection_def bot_option_def null_option_def null_Set⇩b⇩a⇩s⇩e_def bot_Set⇩b⇩a⇩s⇩e_def invalid_def)
apply(erule_tac Q="Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e y⌉⌉ ∩ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋ = Abs_Set⇩b⇩a⇩s⇩e None" in contrapos_pp)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inject[OF OclIntersection_inv A])
apply(simp_all add: null_Set⇩b⇩a⇩s⇩e_def bot_Set⇩b⇩a⇩s⇩e_def bot_option_def)
apply(erule_tac Q="Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e y⌉⌉ ∩ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e x⌉⌉⌋⌋ = Abs_Set⇩b⇩a⇩s⇩e ⌊None⌋" in contrapos_pp)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inject[OF OclIntersection_inv B])
apply(simp_all add: null_Set⇩b⇩a⇩s⇩e_def bot_Set⇩b⇩a⇩s⇩e_def bot_option_def)
done
qed
subsection‹Definition (future operators)›
consts
OclCount :: "[('𝔄,'α::null) Set,('𝔄,'α) Set] ⇒ '𝔄 Integer"
OclSum :: " ('𝔄,'α::null) Set ⇒ '𝔄 Integer"
notation OclCount ("_->count⇩S⇩e⇩t'(_')" )
notation OclSum ("_->sum⇩S⇩e⇩t'(')" )
subsection‹Logical Properties›
text‹OclIncluding›
lemma OclIncluding_valid_args_valid:
"(τ ⊨ υ(X->including⇩S⇩e⇩t(x))) = ((τ ⊨(δ X)) ∧ (τ ⊨(υ x)))"
by (metis (hide_lams, no_types) OclIncluding.def_valid_then_def OclIncluding.defined_args_valid)
lemma OclIncluding_valid_args_valid''[simp,code_unfold]:
"υ(X->including⇩S⇩e⇩t(x)) = ((δ X) and (υ x))"
by (simp add: OclIncluding.def_valid_then_def)
text‹etc. etc.›
text_raw‹\isatagafp›
text‹OclExcluding›
lemma OclExcluding_valid_args_valid:
"(τ ⊨ υ(X->excluding⇩S⇩e⇩t(x))) = ((τ ⊨(δ X)) ∧ (τ ⊨(υ x)))"
by (metis OclExcluding.def_valid_then_def OclExcluding.defined_args_valid)
lemma OclExcluding_valid_args_valid''[simp,code_unfold]:
"υ(X->excluding⇩S⇩e⇩t(x)) = ((δ X) and (υ x))"
by (simp add: OclExcluding.def_valid_then_def)
text‹OclIncludes›
lemma OclIncludes_valid_args_valid:
"(τ ⊨ υ(X->includes⇩S⇩e⇩t(x))) = ((τ ⊨(δ X)) ∧ (τ ⊨(υ x)))"
by (simp add: OclIncludes.def_valid_then_def foundation10')
lemma OclIncludes_valid_args_valid''[simp,code_unfold]:
"υ(X->includes⇩S⇩e⇩t(x)) = ((δ X) and (υ x))"
by (simp add: OclIncludes.def_valid_then_def)
text‹OclExcludes›
lemma OclExcludes_valid_args_valid:
"(τ ⊨ υ(X->excludes⇩S⇩e⇩t(x))) = ((τ ⊨(δ X)) ∧ (τ ⊨(υ x)))"
by (simp add: OclExcludes.def_valid_then_def foundation10')
lemma OclExcludes_valid_args_valid''[simp,code_unfold]:
"υ(X->excludes⇩S⇩e⇩t(x)) = ((δ X) and (υ x))"
by (simp add: OclExcludes.def_valid_then_def)
text‹OclSize›
lemma OclSize_defined_args_valid: "τ ⊨ δ (X->size⇩S⇩e⇩t()) ⟹ τ ⊨ δ X"
by(auto simp: OclSize_def OclValid_def true_def valid_def false_def StrongEq_def
defined_def invalid_def bot_fun_def null_fun_def
split: bool.split_asm HOL.if_split_asm option.split)
lemma OclSize_infinite:
assumes non_finite:"τ ⊨ not(δ(S->size⇩S⇩e⇩t()))"
shows "(τ ⊨ not(δ(S))) ∨ ¬ finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉"
apply(insert non_finite, simp)
apply(rule impI)
apply(simp add: OclSize_def OclValid_def defined_def)
apply(case_tac "finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉",
simp_all add:null_fun_def null_option_def bot_fun_def bot_option_def)
done
lemma "τ ⊨ δ X ⟹ ¬ finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ ⟹ ¬ τ ⊨ δ (X->size⇩S⇩e⇩t())"
by(simp add: OclSize_def OclValid_def defined_def bot_fun_def false_def true_def)
lemma size_defined:
assumes X_finite: "⋀τ. finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
shows "δ (X->size⇩S⇩e⇩t()) = δ X"
apply(rule ext, simp add: cp_defined[of "X->size⇩S⇩e⇩t()"] OclSize_def)
apply(simp add: defined_def bot_option_def bot_fun_def null_option_def null_fun_def X_finite)
done
lemma size_defined':
assumes X_finite: "finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
shows "(τ ⊨ δ (X->size⇩S⇩e⇩t())) = (τ ⊨ δ X)"
apply(simp add: cp_defined[of "X->size⇩S⇩e⇩t()"] OclSize_def OclValid_def)
apply(simp add: defined_def bot_option_def bot_fun_def null_option_def null_fun_def X_finite)
done
text‹OclIsEmpty›
lemma OclIsEmpty_defined_args_valid:"τ ⊨ δ (X->isEmpty⇩S⇩e⇩t()) ⟹ τ ⊨ υ X"
apply(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def
bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def
split: if_split_asm)
apply(case_tac "(X->size⇩S⇩e⇩t() ≐ 𝟬) τ", simp add: bot_option_def, simp, rename_tac x)
apply(case_tac x, simp add: null_option_def bot_option_def, simp)
apply(simp add: OclSize_def StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r valid_def)
by (metis (hide_lams, no_types)
bot_fun_def OclValid_def defined_def foundation2 invalid_def)
lemma "τ ⊨ δ (null->isEmpty⇩S⇩e⇩t())"
by(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def
bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def null_is_valid
split: if_split_asm)
lemma OclIsEmpty_infinite: "τ ⊨ δ X ⟹ ¬ finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ ⟹ ¬ τ ⊨ δ (X->isEmpty⇩S⇩e⇩t())"
apply(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def
bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def
split: if_split_asm)
apply(case_tac "(X->size⇩S⇩e⇩t() ≐ 𝟬) τ", simp add: bot_option_def, simp, rename_tac x)
apply(case_tac x, simp add: null_option_def bot_option_def, simp)
by(simp add: OclSize_def StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r valid_def bot_fun_def false_def true_def invalid_def)
text‹OclNotEmpty›
lemma OclNotEmpty_defined_args_valid:"τ ⊨ δ (X->notEmpty⇩S⇩e⇩t()) ⟹ τ ⊨ υ X"
by (metis (hide_lams, no_types) OclNotEmpty_def OclNot_defargs OclNot_not foundation6 foundation9
OclIsEmpty_defined_args_valid)
lemma "τ ⊨ δ (null->notEmpty⇩S⇩e⇩t())"
by (metis (hide_lams, no_types) OclNotEmpty_def OclAnd_false1 OclAnd_idem OclIsEmpty_def
OclNot3 OclNot4 OclOr_def defined2 defined4 transform1 valid2)
lemma OclNotEmpty_infinite: "τ ⊨ δ X ⟹ ¬ finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ ⟹ ¬ τ ⊨ δ (X->notEmpty⇩S⇩e⇩t())"
apply(simp add: OclNotEmpty_def)
apply(drule OclIsEmpty_infinite, simp)
by (metis OclNot_defargs OclNot_not foundation6 foundation9)
lemma OclNotEmpty_has_elt : "τ ⊨ δ X ⟹
τ ⊨ X->notEmpty⇩S⇩e⇩t() ⟹
∃e. e ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
apply(simp add: OclNotEmpty_def OclIsEmpty_def deMorgan1 deMorgan2, drule foundation5)
apply(subst (asm) (2) OclNot_def,
simp add: OclValid_def StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r StrongEq_def
split: if_split_asm)
prefer 2
apply(simp add: invalid_def bot_option_def true_def)
apply(simp add: OclSize_def valid_def split: if_split_asm,
simp_all add: false_def true_def bot_option_def bot_fun_def OclInt0_def)
by (metis equals0I)
text‹OclANY›
lemma OclANY_defined_args_valid: "τ ⊨ δ (X->any⇩S⇩e⇩t()) ⟹ τ ⊨ δ X"
by(auto simp: OclANY_def OclValid_def true_def valid_def false_def StrongEq_def
defined_def invalid_def bot_fun_def null_fun_def OclAnd_def
split: bool.split_asm HOL.if_split_asm option.split)
lemma "τ ⊨ δ X ⟹ τ ⊨ X->isEmpty⇩S⇩e⇩t() ⟹ ¬ τ ⊨ δ (X->any⇩S⇩e⇩t())"
apply(simp add: OclANY_def OclValid_def)
apply(subst cp_defined, subst cp_OclAnd, simp add: OclNotEmpty_def, subst (1 2) cp_OclNot,
simp add: cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_defined[symmetric],
simp add: false_def true_def)
by(drule foundation20[simplified OclValid_def true_def], simp)
lemma OclANY_valid_args_valid:
"(τ ⊨ υ(X->any⇩S⇩e⇩t())) = (τ ⊨ υ X)"
proof -
have A: "(τ ⊨ υ(X->any⇩S⇩e⇩t())) ⟹ ((τ ⊨(υ X)))"
by(auto simp: OclANY_def OclValid_def true_def valid_def false_def StrongEq_def
defined_def invalid_def bot_fun_def null_fun_def
split: bool.split_asm HOL.if_split_asm option.split)
have B: "(τ ⊨(υ X)) ⟹ (τ ⊨ υ(X->any⇩S⇩e⇩t()))"
apply(auto simp: OclANY_def OclValid_def true_def false_def StrongEq_def
defined_def invalid_def valid_def bot_fun_def null_fun_def
bot_option_def null_option_def null_is_valid
OclAnd_def
split: bool.split_asm HOL.if_split_asm option.split)
apply(frule Set_inv_lemma[OF foundation16[THEN iffD2], OF conjI], simp)
apply(subgoal_tac "(δ X) τ = true τ")
prefer 2
apply (metis (hide_lams, no_types) OclValid_def foundation16)
apply(simp add: true_def,
drule OclNotEmpty_has_elt[simplified OclValid_def true_def], simp)
by(erule exE,
insert someI2[where Q = "λx. x ≠ ⊥" and P = "λy. y ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"],
simp)
show ?thesis by(auto dest:A intro:B)
qed
lemma OclANY_valid_args_valid''[simp,code_unfold]:
"υ(X->any⇩S⇩e⇩t()) = (υ X)"
by(auto intro!: OclANY_valid_args_valid transform2_rev)
text_raw‹\endisatagafp›
subsection‹Execution Laws with Invalid or Null or Infinite Set as Argument›
text‹OclIncluding›
text‹OclExcluding›
text‹OclIncludes›
text‹OclExcludes›
text‹OclSize›
lemma OclSize_invalid[simp,code_unfold]:"(invalid->size⇩S⇩e⇩t()) = invalid"
by(simp add: bot_fun_def OclSize_def invalid_def defined_def valid_def false_def true_def)
lemma OclSize_null[simp,code_unfold]:"(null->size⇩S⇩e⇩t()) = invalid"
by(rule ext,
simp add: bot_fun_def null_fun_def null_is_valid OclSize_def
invalid_def defined_def valid_def false_def true_def)
text‹OclIsEmpty›
lemma OclIsEmpty_invalid[simp,code_unfold]:"(invalid->isEmpty⇩S⇩e⇩t()) = invalid"
by(simp add: OclIsEmpty_def)
lemma OclIsEmpty_null[simp,code_unfold]:"(null->isEmpty⇩S⇩e⇩t()) = true"
by(simp add: OclIsEmpty_def)
text‹OclNotEmpty›
lemma OclNotEmpty_invalid[simp,code_unfold]:"(invalid->notEmpty⇩S⇩e⇩t()) = invalid"
by(simp add: OclNotEmpty_def)
lemma OclNotEmpty_null[simp,code_unfold]:"(null->notEmpty⇩S⇩e⇩t()) = false"
by(simp add: OclNotEmpty_def)
text‹OclANY›
lemma OclANY_invalid[simp,code_unfold]:"(invalid->any⇩S⇩e⇩t()) = invalid"
by(simp add: bot_fun_def OclANY_def invalid_def defined_def valid_def false_def true_def)
lemma OclANY_null[simp,code_unfold]:"(null->any⇩S⇩e⇩t()) = null"
by(simp add: OclANY_def false_def true_def)
text‹OclForall›
lemma OclForall_invalid[simp,code_unfold]:"invalid->forAll⇩S⇩e⇩t(a| P a) = invalid"
by(simp add: bot_fun_def invalid_def OclForall_def defined_def valid_def false_def true_def)
lemma OclForall_null[simp,code_unfold]:"null->forAll⇩S⇩e⇩t(a | P a) = invalid"
by(simp add: bot_fun_def invalid_def OclForall_def defined_def valid_def false_def true_def)
text‹OclExists›
lemma OclExists_invalid[simp,code_unfold]:"invalid->exists⇩S⇩e⇩t(a| P a) = invalid"
by(simp add: OclExists_def)
lemma OclExists_null[simp,code_unfold]:"null->exists⇩S⇩e⇩t(a | P a) = invalid"
by(simp add: OclExists_def)
text‹OclIterate›
lemma OclIterate_invalid[simp,code_unfold]:"invalid->iterate⇩S⇩e⇩t(a; x = A | P a x) = invalid"
by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def)
lemma OclIterate_null[simp,code_unfold]:"null->iterate⇩S⇩e⇩t(a; x = A | P a x) = invalid"
by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def)
lemma OclIterate_invalid_args[simp,code_unfold]:"S->iterate⇩S⇩e⇩t(a; x = invalid | P a x) = invalid"
by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def)
text‹An open question is this ...›
lemma "S->iterate⇩S⇩e⇩t(a; x = null | P a x) = invalid"
oops
lemma OclIterate_infinite:
assumes non_finite: "τ ⊨ not(δ(S->size⇩S⇩e⇩t()))"
shows "(OclIterate S A F) τ = invalid τ"
apply(insert non_finite [THEN OclSize_infinite])
apply(subst (asm) foundation9, simp)
by(metis OclIterate_def OclValid_def invalid_def)
text‹OclSelect›
lemma OclSelect_invalid[simp,code_unfold]:"invalid->select⇩S⇩e⇩t(a | P a) = invalid"
by(simp add: bot_fun_def invalid_def OclSelect_def defined_def valid_def false_def true_def)
lemma OclSelect_null[simp,code_unfold]:"null->select⇩S⇩e⇩t(a | P a) = invalid"
by(simp add: bot_fun_def invalid_def OclSelect_def defined_def valid_def false_def true_def)
text‹OclReject›
lemma OclReject_invalid[simp,code_unfold]:"invalid->reject⇩S⇩e⇩t(a | P a) = invalid"
by(simp add: OclReject_def)
lemma OclReject_null[simp,code_unfold]:"null->reject⇩S⇩e⇩t(a | P a) = invalid"
by(simp add: OclReject_def)
text_raw‹\isatagafp›
subsubsection‹Context Passing›
lemma cp_OclIncludes1:
"(X->includes⇩S⇩e⇩t(x)) τ = (X->includes⇩S⇩e⇩t(λ _. x τ)) τ"
by(auto simp: OclIncludes_def StrongEq_def invalid_def
cp_defined[symmetric] cp_valid[symmetric])
lemma cp_OclSize: "X->size⇩S⇩e⇩t() τ = ((λ_. X τ)->size⇩S⇩e⇩t()) τ"
by(simp add: OclSize_def cp_defined[symmetric])
lemma cp_OclIsEmpty: "X->isEmpty⇩S⇩e⇩t() τ = ((λ_. X τ)->isEmpty⇩S⇩e⇩t()) τ"
apply(simp only: OclIsEmpty_def)
apply(subst (2) cp_OclOr,
subst cp_OclAnd,
subst cp_OclNot,
subst StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.cp0)
by(simp add: cp_defined[symmetric] cp_valid[symmetric] StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.cp0[symmetric]
cp_OclSize[symmetric] cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric])
lemma cp_OclNotEmpty: "X->notEmpty⇩S⇩e⇩t() τ = ((λ_. X τ)->notEmpty⇩S⇩e⇩t()) τ"
apply(simp only: OclNotEmpty_def)
apply(subst (2) cp_OclNot)
by(simp add: cp_OclNot[symmetric] cp_OclIsEmpty[symmetric])
lemma cp_OclANY: "X->any⇩S⇩e⇩t() τ = ((λ_. X τ)->any⇩S⇩e⇩t()) τ"
apply(simp only: OclANY_def)
apply(subst (2) cp_OclAnd)
by(simp only: cp_OclAnd[symmetric] cp_defined[symmetric] cp_valid[symmetric]
cp_OclNotEmpty[symmetric])
lemma cp_OclForall:
"(S->forAll⇩S⇩e⇩t(x | P x)) τ = ((λ _. S τ)->forAll⇩S⇩e⇩t(x | P (λ _. x τ))) τ"
by(simp add: OclForall_def cp_defined[symmetric])
lemma cp_OclForall1 [simp,intro!]:
"cp S ⟹ cp (λX. ((S X)->forAll⇩S⇩e⇩t(x | P x)))"
apply(simp add: cp_def)
apply(erule exE, rule exI, intro allI)
apply(erule_tac x=X in allE)
by(subst cp_OclForall, simp)
lemma
"cp (λX St x. P (λτ. x) X St) ⟹ cp S ⟹ cp (λX. (S X)->forAll⇩S⇩e⇩t(x|P x X)) "
apply(simp only: cp_def)
oops
lemma
"cp S ⟹
(⋀ x. cp(P x)) ⟹
cp(λX. ((S X)->forAll⇩S⇩e⇩t(x | P x X)))"
oops
lemma cp_OclExists:
"(S->exists⇩S⇩e⇩t(x | P x)) τ = ((λ _. S τ)->exists⇩S⇩e⇩t(x | P (λ _. x τ))) τ"
by(simp add: OclExists_def OclNot_def, subst cp_OclForall, simp)
lemma cp_OclExists1 [simp,intro!]:
"cp S ⟹ cp (λX. ((S X)->exists⇩S⇩e⇩t(x | P x)))"
apply(simp add: cp_def)
apply(erule exE, rule exI, intro allI)
apply(erule_tac x=X in allE)
by(subst cp_OclExists,simp)
lemma cp_OclIterate:
"(X->iterate⇩S⇩e⇩t(a; x = A | P a x)) τ =
((λ _. X τ)->iterate⇩S⇩e⇩t(a; x = A | P a x)) τ"
by(simp add: OclIterate_def cp_defined[symmetric])
lemma cp_OclSelect: "(X->select⇩S⇩e⇩t(a | P a)) τ =
((λ _. X τ)->select⇩S⇩e⇩t(a | P a)) τ"
by(simp add: OclSelect_def cp_defined[symmetric])
lemma cp_OclReject: "(X->reject⇩S⇩e⇩t(a | P a)) τ = ((λ _. X τ)->reject⇩S⇩e⇩t(a | P a)) τ"
by(simp add: OclReject_def, subst cp_OclSelect, simp)
lemmas cp_intro''⇩S⇩e⇩t[intro!,simp,code_unfold] =
cp_OclSize [THEN allI[THEN allI[THEN cpI1], of "OclSize"]]
cp_OclIsEmpty [THEN allI[THEN allI[THEN cpI1], of "OclIsEmpty"]]
cp_OclNotEmpty [THEN allI[THEN allI[THEN cpI1], of "OclNotEmpty"]]
cp_OclANY [THEN allI[THEN allI[THEN cpI1], of "OclANY"]]
subsubsection‹Const›
lemma const_OclIncluding[simp,code_unfold] :
assumes const_x : "const x"
and const_S : "const S"
shows "const (S->including⇩S⇩e⇩t(x))"
proof -
have A:"⋀τ τ'. ¬ (τ ⊨ υ x) ⟹ (S->including⇩S⇩e⇩t(x) τ) = (S->including⇩S⇩e⇩t(x) τ')"
apply(simp add: foundation18)
apply(erule const_subst[OF const_x const_invalid],simp_all)
by(rule const_charn[OF const_invalid])
have B: "⋀ τ τ'. ¬ (τ ⊨ δ S) ⟹ (S->including⇩S⇩e⇩t(x) τ) = (S->including⇩S⇩e⇩t(x) τ')"
apply(simp add: foundation16', elim disjE)
apply(erule const_subst[OF const_S const_invalid],simp_all)
apply(rule const_charn[OF const_invalid])
apply(erule const_subst[OF const_S const_null],simp_all)
by(rule const_charn[OF const_invalid])
show ?thesis
apply(simp only: const_def,intro allI, rename_tac τ τ')
apply(case_tac "¬ (τ ⊨ υ x)", simp add: A)
apply(case_tac "¬ (τ ⊨ δ S)", simp_all add: B)
apply(frule_tac τ'1= τ' in const_OclValid2[OF const_x, THEN iffD1])
apply(frule_tac τ'1= τ' in const_OclValid1[OF const_S, THEN iffD1])
apply(simp add: OclIncluding_def OclValid_def)
apply(subst const_charn[OF const_x])
apply(subst const_charn[OF const_S])
by simp
qed
text_raw‹\endisatagafp›
subsection‹General Algebraic Execution Rules›
subsubsection‹Execution Rules on Including›
lemma OclIncluding_finite_rep_set :
assumes X_def : "τ ⊨ δ X"
and x_val : "τ ⊨ υ x"
shows "finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->including⇩S⇩e⇩t(x) τ)⌉⌉ = finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
proof -
have C : "⌊⌊insert (x τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(insert X_def x_val, frule Set_inv_lemma, simp add: foundation18 invalid_def)
show "?thesis"
by(insert X_def x_val,
auto simp: OclIncluding_def Abs_Set⇩b⇩a⇩s⇩e_inverse[OF C]
dest: foundation13[THEN iffD2, THEN foundation22[THEN iffD1]])
qed
lemma OclIncluding_rep_set:
assumes S_def: "τ ⊨ δ S"
shows "⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S->including⇩S⇩e⇩t(λ_. ⌊⌊x⌋⌋) τ)⌉⌉ = insert ⌊⌊x⌋⌋ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉"
apply(simp add: OclIncluding_def S_def[simplified OclValid_def])
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def null_option_def)
apply(insert Set_inv_lemma[OF S_def], metis bot_option_def not_Some_eq)
by(simp)
lemma OclIncluding_notempty_rep_set:
assumes X_def: "τ ⊨ δ X"
and a_val: "τ ⊨ υ a"
shows "⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->including⇩S⇩e⇩t(a) τ)⌉⌉ ≠ {}"
apply(simp add: OclIncluding_def X_def[simplified OclValid_def] a_val[simplified OclValid_def])
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def null_option_def)
apply(insert Set_inv_lemma[OF X_def], metis a_val foundation18')
by(simp)
lemma OclIncluding_includes0:
assumes "τ ⊨ X->includes⇩S⇩e⇩t(x)"
shows "X->including⇩S⇩e⇩t(x) τ = X τ"
proof -
have includes_def: "τ ⊨ X->includes⇩S⇩e⇩t(x) ⟹ τ ⊨ δ X"
by (metis bot_fun_def OclIncludes_def OclValid_def defined3 foundation16)
have includes_val: "τ ⊨ X->includes⇩S⇩e⇩t(x) ⟹ τ ⊨ υ x"
using foundation5 foundation6 by fastforce
show ?thesis
apply(insert includes_def[OF assms] includes_val[OF assms] assms,
simp add: OclIncluding_def OclIncludes_def OclValid_def true_def)
apply(drule insert_absorb, simp, subst abs_rep_simp')
by(simp_all add: OclValid_def true_def)
qed
lemma OclIncluding_includes:
assumes "τ ⊨ X->includes⇩S⇩e⇩t(x)"
shows "τ ⊨ X->including⇩S⇩e⇩t(x) ≜ X"
by(simp add: StrongEq_def OclValid_def true_def OclIncluding_includes0[OF assms])
lemma OclIncluding_commute0 :
assumes S_def : "τ ⊨ δ S"
and i_val : "τ ⊨ υ i"
and j_val : "τ ⊨ υ j"
shows "τ ⊨ ((S :: ('𝔄, 'a::null) Set)->including⇩S⇩e⇩t(i)->including⇩S⇩e⇩t(j) ≜ (S->including⇩S⇩e⇩t(j)->including⇩S⇩e⇩t(i)))"
proof -
have A : "⌊⌊insert (i τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(insert S_def i_val, frule Set_inv_lemma, simp add: foundation18 invalid_def)
have B : "⌊⌊insert (j τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(insert S_def j_val, frule Set_inv_lemma, simp add: foundation18 invalid_def)
have G1 : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊insert (i τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉⌋⌋ ≠ Abs_Set⇩b⇩a⇩s⇩e None"
by(insert A, simp add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
have G2 : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊insert (i τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉⌋⌋ ≠ Abs_Set⇩b⇩a⇩s⇩e ⌊None⌋"
by(insert A, simp add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
have G3 : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊insert (j τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉⌋⌋ ≠ Abs_Set⇩b⇩a⇩s⇩e None"
by(insert B, simp add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
have G4 : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊insert (j τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉⌋⌋ ≠ Abs_Set⇩b⇩a⇩s⇩e ⌊None⌋"
by(insert B, simp add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
have * : "(δ (λ_. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊insert (i τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉⌋⌋)) τ = ⌊⌊True⌋⌋"
by(auto simp: OclValid_def false_def defined_def null_fun_def true_def
bot_fun_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def S_def i_val G1 G2)
have ** : "(δ (λ_. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊insert (j τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉⌋⌋)) τ = ⌊⌊True⌋⌋"
by(auto simp: OclValid_def false_def defined_def null_fun_def true_def
bot_fun_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def S_def i_val G3 G4)
have *** : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊insert(j τ)⌈⌈Rep_Set⇩b⇩a⇩s⇩e(Abs_Set⇩b⇩a⇩s⇩e⌊⌊insert(i τ)⌈⌈Rep_Set⇩b⇩a⇩s⇩e(S τ)⌉⌉⌋⌋)⌉⌉⌋⌋ =
Abs_Set⇩b⇩a⇩s⇩e ⌊⌊insert(i τ)⌈⌈Rep_Set⇩b⇩a⇩s⇩e(Abs_Set⇩b⇩a⇩s⇩e⌊⌊insert(j τ)⌈⌈Rep_Set⇩b⇩a⇩s⇩e(S τ)⌉⌉⌋⌋)⌉⌉⌋⌋"
by(simp add: Abs_Set⇩b⇩a⇩s⇩e_inverse[OF A] Abs_Set⇩b⇩a⇩s⇩e_inverse[OF B] Set.insert_commute)
show ?thesis
apply(simp add: OclIncluding_def S_def[simplified OclValid_def]
i_val[simplified OclValid_def] j_val[simplified OclValid_def]
true_def OclValid_def StrongEq_def)
apply(subst cp_defined,
simp add: S_def[simplified OclValid_def]
i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def *)
apply(subst cp_defined,
simp add: S_def[simplified OclValid_def]
i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def ** ***)
apply(subst cp_defined,
simp add: S_def[simplified OclValid_def]
i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def *)
apply(subst cp_defined,
simp add: S_def[simplified OclValid_def]
i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * )
apply(subst cp_defined,
simp add: S_def[simplified OclValid_def]
i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * **)
done
qed
lemma OclIncluding_commute[simp,code_unfold]:
"((S :: ('𝔄, 'a::null) Set)->including⇩S⇩e⇩t(i)->including⇩S⇩e⇩t(j) = (S->including⇩S⇩e⇩t(j)->including⇩S⇩e⇩t(i)))"
proof -
have A: "⋀ τ. τ ⊨ (i ≜ invalid) ⟹ (S->including⇩S⇩e⇩t(i)->including⇩S⇩e⇩t(j)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have A': "⋀ τ. τ ⊨ (i ≜ invalid) ⟹ (S->including⇩S⇩e⇩t(j)->including⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have B:"⋀ τ. τ ⊨ (j ≜ invalid) ⟹ (S->including⇩S⇩e⇩t(i)->including⇩S⇩e⇩t(j)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have B':"⋀ τ. τ ⊨ (j ≜ invalid) ⟹ (S->including⇩S⇩e⇩t(j)->including⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have C: "⋀ τ. τ ⊨ (S ≜ invalid) ⟹ (S->including⇩S⇩e⇩t(i)->including⇩S⇩e⇩t(j)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have C': "⋀ τ. τ ⊨ (S ≜ invalid) ⟹ (S->including⇩S⇩e⇩t(j)->including⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have D: "⋀ τ. τ ⊨ (S ≜ null) ⟹ (S->including⇩S⇩e⇩t(i)->including⇩S⇩e⇩t(j)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have D': "⋀ τ. τ ⊨ (S ≜ null) ⟹ (S->including⇩S⇩e⇩t(j)->including⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
show ?thesis
apply(rule ext, rename_tac τ)
apply(case_tac "τ ⊨ (υ i)")
apply(case_tac "τ ⊨ (υ j)")
apply(case_tac "τ ⊨ (δ S)")
apply(simp only: OclIncluding_commute0[THEN foundation22[THEN iffD1]])
apply(simp add: foundation16', elim disjE)
apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]])
apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]])
apply(simp add:foundation18 B[OF foundation22[THEN iffD2]] B'[OF foundation22[THEN iffD2]])
apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]])
done
qed
subsubsection‹Execution Rules on Excluding›
lemma OclExcluding_finite_rep_set :
assumes X_def : "τ ⊨ δ X"
and x_val : "τ ⊨ υ x"
shows "finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->excluding⇩S⇩e⇩t(x) τ)⌉⌉ = finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
proof -
have C : "⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ - {x τ}⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
apply(insert X_def x_val, frule Set_inv_lemma)
apply(simp add: foundation18 invalid_def)
done
show "?thesis"
by(insert X_def x_val,
auto simp: OclExcluding_def Abs_Set⇩b⇩a⇩s⇩e_inverse[OF C]
dest: foundation13[THEN iffD2, THEN foundation22[THEN iffD1]])
qed
lemma OclExcluding_rep_set:
assumes S_def: "τ ⊨ δ S"
shows "⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S->excluding⇩S⇩e⇩t(λ_. ⌊⌊x⌋⌋) τ)⌉⌉ = ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ - {⌊⌊x⌋⌋}"
apply(simp add: OclExcluding_def S_def[simplified OclValid_def])
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def null_option_def)
apply(insert Set_inv_lemma[OF S_def], metis Diff_iff bot_option_def not_None_eq)
by(simp)
lemma OclExcluding_excludes0:
assumes "τ ⊨ X->excludes⇩S⇩e⇩t(x)"
shows "X->excluding⇩S⇩e⇩t(x) τ = X τ"
proof -
have excludes_def: "τ ⊨ X->excludes⇩S⇩e⇩t(x) ⟹ τ ⊨ δ X"
by (metis OclExcludes.def_valid_then_def OclExcludes_valid_args_valid'' foundation10' foundation6)
have excludes_val: "τ ⊨ X->excludes⇩S⇩e⇩t(x) ⟹ τ ⊨ υ x"
by (metis OclExcludes.def_valid_then_def OclExcludes_valid_args_valid'' foundation10' foundation6)
show ?thesis
apply(insert excludes_def[OF assms] excludes_val[OF assms] assms,
simp add: OclExcluding_def OclExcludes_def OclIncludes_def OclNot_def OclValid_def true_def)
by (metis (hide_lams, no_types) abs_rep_simp' assms excludes_def)
qed
lemma OclExcluding_excludes:
assumes "τ ⊨ X->excludes⇩S⇩e⇩t(x)"
shows "τ ⊨ X->excluding⇩S⇩e⇩t(x) ≜ X"
by(simp add: StrongEq_def OclValid_def true_def OclExcluding_excludes0[OF assms])
lemma OclExcluding_charn0[simp]:
assumes val_x:"τ ⊨ (υ x)"
shows "τ ⊨ ((Set{}->excluding⇩S⇩e⇩t(x)) ≜ Set{})"
proof -
have A : "⌊None⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(simp add: null_option_def bot_option_def)
have B : "⌊⌊{}⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}" by(simp add: mtSet_def)
show ?thesis using val_x
apply(auto simp: OclValid_def OclIncludes_def OclNot_def false_def true_def StrongEq_def
OclExcluding_def mtSet_def defined_def bot_fun_def null_fun_def null_Set⇩b⇩a⇩s⇩e_def)
apply(auto simp: mtSet_def Set⇩b⇩a⇩s⇩e.Abs_Set⇩b⇩a⇩s⇩e_inverse
Set⇩b⇩a⇩s⇩e.Abs_Set⇩b⇩a⇩s⇩e_inject[OF B A])
done
qed
lemma OclExcluding_commute0 :
assumes S_def : "τ ⊨ δ S"
and i_val : "τ ⊨ υ i"
and j_val : "τ ⊨ υ j"
shows "τ ⊨ ((S :: ('𝔄, 'a::null) Set)->excluding⇩S⇩e⇩t(i)->excluding⇩S⇩e⇩t(j) ≜ (S->excluding⇩S⇩e⇩t(j)->excluding⇩S⇩e⇩t(i)))"
proof -
have A : "⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ - {i τ}⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(insert S_def i_val, frule Set_inv_lemma, simp add: foundation18 invalid_def)
have B : "⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ - {j τ}⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(insert S_def j_val, frule Set_inv_lemma, simp add: foundation18 invalid_def)
have G1 : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ - {i τ}⌋⌋ ≠ Abs_Set⇩b⇩a⇩s⇩e None"
by(insert A, simp add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
have G2 : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ - {i τ}⌋⌋ ≠ Abs_Set⇩b⇩a⇩s⇩e ⌊None⌋"
by(insert A, simp add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
have G3 : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ - {j τ}⌋⌋ ≠ Abs_Set⇩b⇩a⇩s⇩e None"
by(insert B, simp add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
have G4 : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ - {j τ}⌋⌋ ≠ Abs_Set⇩b⇩a⇩s⇩e ⌊None⌋"
by(insert B, simp add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
have * : "(δ (λ_. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ - {i τ}⌋⌋)) τ = ⌊⌊True⌋⌋"
by(auto simp: OclValid_def false_def defined_def null_fun_def true_def
bot_fun_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def S_def i_val G1 G2)
have ** : "(δ (λ_. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ - {j τ}⌋⌋)) τ = ⌊⌊True⌋⌋"
by(auto simp: OclValid_def false_def defined_def null_fun_def true_def
bot_fun_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def S_def i_val G3 G4)
have *** : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e(Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e(S τ)⌉⌉-{i τ}⌋⌋)⌉⌉-{j τ}⌋⌋ =
Abs_Set⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e(Abs_Set⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e(S τ)⌉⌉-{j τ}⌋⌋)⌉⌉-{i τ}⌋⌋"
apply(simp add: Abs_Set⇩b⇩a⇩s⇩e_inverse[OF A] Abs_Set⇩b⇩a⇩s⇩e_inverse[OF B])
by (metis Diff_insert2 insert_commute)
show ?thesis
apply(simp add: OclExcluding_def S_def[simplified OclValid_def]
i_val[simplified OclValid_def] j_val[simplified OclValid_def]
true_def OclValid_def StrongEq_def)
apply(subst cp_defined,
simp add: S_def[simplified OclValid_def]
i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def *)
apply(subst cp_defined,
simp add: S_def[simplified OclValid_def]
i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def ** ***)
apply(subst cp_defined,
simp add: S_def[simplified OclValid_def]
i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def *)
apply(subst cp_defined,
simp add: S_def[simplified OclValid_def]
i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * )
apply(subst cp_defined,
simp add: S_def[simplified OclValid_def]
i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * **)
done
qed
lemma OclExcluding_commute[simp,code_unfold]:
"((S :: ('𝔄, 'a::null) Set)->excluding⇩S⇩e⇩t(i)->excluding⇩S⇩e⇩t(j) = (S->excluding⇩S⇩e⇩t(j)->excluding⇩S⇩e⇩t(i)))"
proof -
have A: "⋀ τ. τ ⊨ i ≜ invalid ⟹ (S->excluding⇩S⇩e⇩t(i)->excluding⇩S⇩e⇩t(j)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have A': "⋀ τ. τ ⊨ i ≜ invalid ⟹ (S->excluding⇩S⇩e⇩t(j)->excluding⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have B:"⋀ τ. τ ⊨ j ≜ invalid ⟹ (S->excluding⇩S⇩e⇩t(i)->excluding⇩S⇩e⇩t(j)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have B':"⋀ τ. τ ⊨ j ≜ invalid ⟹ (S->excluding⇩S⇩e⇩t(j)->excluding⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have C: "⋀ τ. τ ⊨ S ≜ invalid ⟹ (S->excluding⇩S⇩e⇩t(i)->excluding⇩S⇩e⇩t(j)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have C': "⋀ τ. τ ⊨ S ≜ invalid ⟹ (S->excluding⇩S⇩e⇩t(j)->excluding⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have D: "⋀ τ. τ ⊨ S ≜ null ⟹ (S->excluding⇩S⇩e⇩t(i)->excluding⇩S⇩e⇩t(j)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have D': "⋀ τ. τ ⊨ S ≜ null ⟹ (S->excluding⇩S⇩e⇩t(j)->excluding⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
show ?thesis
apply(rule ext, rename_tac τ)
apply(case_tac "τ ⊨ (υ i)")
apply(case_tac "τ ⊨ (υ j)")
apply(case_tac "τ ⊨ (δ S)")
apply(simp only: OclExcluding_commute0[THEN foundation22[THEN iffD1]])
apply(simp add: foundation16', elim disjE)
apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]])
apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]])
apply(simp add:foundation18 B[OF foundation22[THEN iffD2]] B'[OF foundation22[THEN iffD2]])
apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]])
done
qed
lemma OclExcluding_charn0_exec[simp,code_unfold]:
"(Set{}->excluding⇩S⇩e⇩t(x)) = (if (υ x) then Set{} else invalid endif)"
proof -
have A: "⋀ τ. (Set{}->excluding⇩S⇩e⇩t(invalid)) τ = (if (υ invalid) then Set{} else invalid endif) τ"
by simp
have B: "⋀ τ x. τ ⊨ (υ x) ⟹
(Set{}->excluding⇩S⇩e⇩t(x)) τ = (if (υ x) then Set{} else invalid endif) τ"
by(simp add: OclExcluding_charn0[THEN foundation22[THEN iffD1]])
show ?thesis
apply(rule ext, rename_tac τ)
apply(case_tac "τ ⊨ (υ x)")
apply(simp add: B)
apply(simp add: foundation18)
apply(subst OclExcluding.cp0, simp)
apply(simp add: cp_OclIf[symmetric] OclExcluding.cp0[symmetric] cp_valid[symmetric] A)
done
qed
lemma OclExcluding_charn1:
assumes def_X:"τ ⊨ (δ X)"
and val_x:"τ ⊨ (υ x)"
and val_y:"τ ⊨ (υ y)"
and neq :"τ ⊨ not(x ≜ y)"
shows "τ ⊨ ((X->including⇩S⇩e⇩t(x))->excluding⇩S⇩e⇩t(y)) ≜ ((X->excluding⇩S⇩e⇩t(y))->including⇩S⇩e⇩t(x))"
proof -
have C : "⌊⌊insert (x τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def)
have D : "⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ - {y τ}⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def)
have E : "x τ ≠ y τ"
by(insert neq,
auto simp: OclValid_def bot_fun_def OclIncluding_def OclIncludes_def
false_def true_def defined_def valid_def bot_Set⇩b⇩a⇩s⇩e_def
null_fun_def null_Set⇩b⇩a⇩s⇩e_def StrongEq_def OclNot_def)
have G1 : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊insert (x τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉⌋⌋ ≠ Abs_Set⇩b⇩a⇩s⇩e None"
by(insert C, simp add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
have G2 : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊insert (x τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉⌋⌋ ≠ Abs_Set⇩b⇩a⇩s⇩e ⌊None⌋"
by(insert C, simp add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
have G : "(δ (λ_. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊insert (x τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉⌋⌋)) τ = true τ"
by(auto simp: OclValid_def false_def true_def defined_def
bot_fun_def bot_Set⇩b⇩a⇩s⇩e_def null_fun_def null_Set⇩b⇩a⇩s⇩e_def G1 G2)
have H1 : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ - {y τ}⌋⌋ ≠ Abs_Set⇩b⇩a⇩s⇩e None"
by(insert D, simp add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
have H2 : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ - {y τ}⌋⌋ ≠ Abs_Set⇩b⇩a⇩s⇩e ⌊None⌋"
by(insert D, simp add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
have H : "(δ (λ_. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ - {y τ}⌋⌋)) τ = true τ"
by(auto simp: OclValid_def false_def true_def defined_def
bot_fun_def bot_Set⇩b⇩a⇩s⇩e_def null_fun_def null_Set⇩b⇩a⇩s⇩e_def H1 H2)
have Z : "insert (x τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ - {y τ} = insert (x τ) (⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ - {y τ})"
by(auto simp: E)
show ?thesis
apply(insert def_X[THEN foundation13[THEN iffD2]] val_x[THEN foundation13[THEN iffD2]]
val_y[THEN foundation13[THEN iffD2]])
apply(simp add: foundation22 OclIncluding_def OclExcluding_def def_X[THEN foundation16[THEN iffD1]])
apply(subst cp_defined, simp)+
apply(simp add: G H Abs_Set⇩b⇩a⇩s⇩e_inverse[OF C] Abs_Set⇩b⇩a⇩s⇩e_inverse[OF D] Z)
done
qed
lemma OclExcluding_charn2:
assumes def_X:"τ ⊨ (δ X)"
and val_x:"τ ⊨ (υ x)"
shows "τ ⊨ (((X->including⇩S⇩e⇩t(x))->excluding⇩S⇩e⇩t(x)) ≜ (X->excluding⇩S⇩e⇩t(x)))"
proof -
have C : "⌊⌊insert (x τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def)
have G1 : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊insert (x τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉⌋⌋ ≠ Abs_Set⇩b⇩a⇩s⇩e None"
by(insert C, simp add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
have G2 : "Abs_Set⇩b⇩a⇩s⇩e ⌊⌊insert (x τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉⌋⌋ ≠ Abs_Set⇩b⇩a⇩s⇩e ⌊None⌋"
by(insert C, simp add: Abs_Set⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
show ?thesis
apply(insert def_X[THEN foundation16[THEN iffD1]]
val_x[THEN foundation18[THEN iffD1]])
apply(auto simp: OclValid_def bot_fun_def OclIncluding_def OclIncludes_def false_def true_def
invalid_def defined_def valid_def bot_Set⇩b⇩a⇩s⇩e_def null_fun_def null_Set⇩b⇩a⇩s⇩e_def
StrongEq_def)
apply(subst OclExcluding.cp0)
apply(auto simp:OclExcluding_def)
apply(simp add: Abs_Set⇩b⇩a⇩s⇩e_inverse[OF C])
apply(simp_all add: false_def true_def defined_def valid_def
null_fun_def bot_fun_def null_Set⇩b⇩a⇩s⇩e_def bot_Set⇩b⇩a⇩s⇩e_def
split: bool.split_asm HOL.if_split_asm option.split)
apply(auto simp: G1 G2)
done
qed
theorem OclExcluding_charn3: "((X->including⇩S⇩e⇩t(x))->excluding⇩S⇩e⇩t(x)) = (X->excluding⇩S⇩e⇩t(x))"
proof -
have A1 : "⋀τ. τ ⊨ (X ≜ invalid) ⟹ (X->including⇩S⇩e⇩t(x)->excluding⇩S⇩e⇩t(x)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have A1': "⋀τ. τ ⊨ (X ≜ invalid) ⟹ (X->excluding⇩S⇩e⇩t(x)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have A2 : "⋀τ. τ ⊨ (X ≜ null) ⟹ (X->including⇩S⇩e⇩t(x)->excluding⇩S⇩e⇩t(x)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have A2': "⋀τ. τ ⊨ (X ≜ null) ⟹ (X->excluding⇩S⇩e⇩t(x)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have A3 : "⋀τ. τ ⊨ (x ≜ invalid) ⟹ (X->including⇩S⇩e⇩t(x)->excluding⇩S⇩e⇩t(x)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have A3': "⋀τ. τ ⊨ (x ≜ invalid) ⟹ (X->excluding⇩S⇩e⇩t(x)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
show ?thesis
apply(rule ext, rename_tac "τ")
apply(case_tac "τ ⊨ (υ x)")
apply(case_tac "τ ⊨ (δ X)")
apply(simp only: OclExcluding_charn2[THEN foundation22[THEN iffD1]])
apply(simp add: foundation16', elim disjE)
apply(simp add: A1[OF foundation22[THEN iffD2]] A1'[OF foundation22[THEN iffD2]])
apply(simp add: A2[OF foundation22[THEN iffD2]] A2'[OF foundation22[THEN iffD2]])
apply(simp add:foundation18 A3[OF foundation22[THEN iffD2]] A3'[OF foundation22[THEN iffD2]])
done
qed
text‹One would like a generic theorem of the form:
\begin{isar}[mathescape]
lemma OclExcluding_charn_exec:
"(X->including$_{Set}$(x::('$\mathfrak{A}$,'a::null)val)->excluding$_{Set}$(y)) =
(if δ X then if x ≐ y
then X->excluding$_{Set}$(y)
else X->excluding$_{Set}$(y)->including$_{Set}$(x)
endif
else invalid endif)"
\end{isar}
Unfortunately, this does not hold in general, since referential equality is
an overloaded concept and has to be defined for each type individually.
Consequently, it is only valid for concrete type instances for Boolean,
Integer, and Sets thereof...
›
text‹The computational law \emph{OclExcluding-charn-exec} becomes generic since it
uses strict equality which in itself is generic. It is possible to prove
the following generic theorem and instantiate it later (using properties
that link the polymorphic logical strong equality with the concrete instance
of strict quality).›
lemma OclExcluding_charn_exec:
assumes strict1: "(invalid ≐ y) = invalid"
and strict2: "(x ≐ invalid) = invalid"
and StrictRefEq_valid_args_valid: "⋀ (x::('𝔄,'a::null)val) y τ.
(τ ⊨ δ (x ≐ y)) = ((τ ⊨ (υ x)) ∧ (τ ⊨ υ y))"
and cp_StrictRefEq: "⋀ (X::('𝔄,'a::null)val) Y τ. (X ≐ Y) τ = ((λ_. X τ) ≐ (λ_. Y τ)) τ"
and StrictRefEq_vs_StrongEq: "⋀ (x::('𝔄,'a::null)val) y τ.
τ ⊨ υ x ⟹ τ ⊨ υ y ⟹ (τ ⊨ ((x ≐ y) ≜ (x ≜ y)))"
shows "(X->including⇩S⇩e⇩t(x::('𝔄,'a::null)val)->excluding⇩S⇩e⇩t(y)) =
(if δ X then if x ≐ y
then X->excluding⇩S⇩e⇩t(y)
else X->excluding⇩S⇩e⇩t(y)->including⇩S⇩e⇩t(x)
endif
else invalid endif)"
proof -
have A1: "⋀τ. τ ⊨ (X ≜ invalid) ⟹
(X->including⇩S⇩e⇩t(x)->includes⇩S⇩e⇩t(y)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have B1: "⋀τ. τ ⊨ (X ≜ null) ⟹
(X->including⇩S⇩e⇩t(x)->includes⇩S⇩e⇩t(y)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have A2: "⋀τ. τ ⊨ (X ≜ invalid) ⟹ X->including⇩S⇩e⇩t(x)->excluding⇩S⇩e⇩t(y) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have B2: "⋀τ. τ ⊨ (X ≜ null) ⟹ X->including⇩S⇩e⇩t(x)->excluding⇩S⇩e⇩t(y) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
note [simp] = cp_StrictRefEq [THEN allI[THEN allI[THEN allI[THEN cpI2]], of "StrictRefEq"]]
have C: "⋀τ. τ ⊨ (x ≜ invalid) ⟹
(X->including⇩S⇩e⇩t(x)->excluding⇩S⇩e⇩t(y)) τ =
(if x ≐ y then X->excluding⇩S⇩e⇩t(y) else X->excluding⇩S⇩e⇩t(y)->including⇩S⇩e⇩t(x) endif) τ"
apply(rule foundation22[THEN iffD1])
apply(erule StrongEq_L_subst2_rev,simp,simp)
by(simp add: strict1)
have D: "⋀τ. τ ⊨ (y ≜ invalid) ⟹
(X->including⇩S⇩e⇩t(x)->excluding⇩S⇩e⇩t(y)) τ =
(if x ≐ y then X->excluding⇩S⇩e⇩t(y) else X->excluding⇩S⇩e⇩t(y)->including⇩S⇩e⇩t(x) endif) τ"
apply(rule foundation22[THEN iffD1])
apply(erule StrongEq_L_subst2_rev,simp,simp)
by (simp add: strict2)
have E: "⋀τ. τ ⊨ υ x ⟹ τ ⊨ υ y ⟹
(if x ≐ y then X->excluding⇩S⇩e⇩t(y) else X->excluding⇩S⇩e⇩t(y)->including⇩S⇩e⇩t(x) endif) τ =
(if x ≜ y then X->excluding⇩S⇩e⇩t(y) else X->excluding⇩S⇩e⇩t(y)->including⇩S⇩e⇩t(x) endif) τ"
apply(subst cp_OclIf)
apply(subst StrictRefEq_vs_StrongEq[THEN foundation22[THEN iffD1]])
by(simp_all add: cp_OclIf[symmetric])
have F: "⋀τ. τ ⊨ δ X ⟹ τ ⊨ υ x ⟹ τ ⊨ (x ≜ y) ⟹
(X->including⇩S⇩e⇩t(x)->excluding⇩S⇩e⇩t(y) τ) = (X->excluding⇩S⇩e⇩t(y) τ)"
apply(drule StrongEq_L_sym)
apply(rule foundation22[THEN iffD1])
apply(erule StrongEq_L_subst2_rev,simp)
by(simp add: OclExcluding_charn2)
show ?thesis
apply(rule ext, rename_tac "τ")
apply(case_tac "¬ (τ ⊨ (δ X))", simp add:defined_split,elim disjE A1 B1 A2 B2)
apply(case_tac "¬ (τ ⊨ (υ x))",
simp add:foundation18 foundation22[symmetric],
drule StrongEq_L_sym)
apply(simp add: foundation22 C)
apply(case_tac "¬ (τ ⊨ (υ y))",
simp add:foundation18 foundation22[symmetric],
drule StrongEq_L_sym, simp add: foundation22 D, simp)
apply(subst E,simp_all)
apply(case_tac "τ ⊨ not (x ≜ y)")
apply(simp add: OclExcluding_charn1[simplified foundation22]
OclExcluding_charn2[simplified foundation22])
apply(simp add: foundation9 F)
done
qed
schematic_goal OclExcluding_charn_exec⇩I⇩n⇩t⇩e⇩g⇩e⇩r[simp,code_unfold]: "?X"
by(rule OclExcluding_charn_exec[OF StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.strict1 StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.strict2
StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.defined_args_valid
StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.cp0 StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.StrictRefEq_vs_StrongEq], simp_all)
schematic_goal OclExcluding_charn_exec⇩B⇩o⇩o⇩l⇩e⇩a⇩n[simp,code_unfold]: "?X"
by(rule OclExcluding_charn_exec[OF StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n.strict1 StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n.strict2
StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n.defined_args_valid
StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n.cp0 StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n.StrictRefEq_vs_StrongEq], simp_all)
schematic_goal OclExcluding_charn_exec⇩S⇩e⇩t[simp,code_unfold]: "?X"
by(rule OclExcluding_charn_exec[OF StrictRefEq⇩S⇩e⇩t.strict1 StrictRefEq⇩S⇩e⇩t.strict2
StrictRefEq⇩S⇩e⇩t.defined_args_valid
StrictRefEq⇩S⇩e⇩t.cp0 StrictRefEq⇩S⇩e⇩t.StrictRefEq_vs_StrongEq], simp_all)
subsubsection‹Execution Rules on Includes›
lemma OclIncludes_charn0[simp]:
assumes val_x:"τ ⊨ (υ x)"
shows "τ ⊨ not(Set{}->includes⇩S⇩e⇩t(x))"
using val_x
apply(auto simp: OclValid_def OclIncludes_def OclNot_def false_def true_def)
apply(auto simp: mtSet_def Set⇩b⇩a⇩s⇩e.Abs_Set⇩b⇩a⇩s⇩e_inverse)
done
lemma OclIncludes_charn0'[simp,code_unfold]:
"Set{}->includes⇩S⇩e⇩t(x) = (if υ x then false else invalid endif)"
proof -
have A: "⋀ τ. (Set{}->includes⇩S⇩e⇩t(invalid)) τ = (if (υ invalid) then false else invalid endif) τ"
by simp
have B: "⋀ τ x. τ ⊨ (υ x) ⟹ (Set{}->includes⇩S⇩e⇩t(x)) τ = (if υ x then false else invalid endif) τ"
apply(frule OclIncludes_charn0, simp add: OclValid_def)
apply(rule foundation21[THEN fun_cong, simplified StrongEq_def,simplified,
THEN iffD1, of _ _ "false"])
by simp
show ?thesis
apply(rule ext, rename_tac τ)
apply(case_tac "τ ⊨ (υ x)")
apply(simp_all add: B foundation18)
apply(subst OclIncludes.cp0, simp add: OclIncludes.cp0[symmetric] A)
done
qed
lemma OclIncludes_charn1:
assumes def_X:"τ ⊨ (δ X)"
assumes val_x:"τ ⊨ (υ x)"
shows "τ ⊨ (X->including⇩S⇩e⇩t(x)->includes⇩S⇩e⇩t(x))"
proof -
have C : "⌊⌊insert (x τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def)
show ?thesis
apply(subst OclIncludes_def, simp add: foundation10[simplified OclValid_def] OclValid_def
def_X[simplified OclValid_def] val_x[simplified OclValid_def])
apply(simp add: OclIncluding_def def_X[simplified OclValid_def] val_x[simplified OclValid_def]
Abs_Set⇩b⇩a⇩s⇩e_inverse[OF C] true_def)
done
qed
lemma OclIncludes_charn2:
assumes def_X:"τ ⊨ (δ X)"
and val_x:"τ ⊨ (υ x)"
and val_y:"τ ⊨ (υ y)"
and neq :"τ ⊨ not(x ≜ y)"
shows "τ ⊨ (X->including⇩S⇩e⇩t(x)->includes⇩S⇩e⇩t(y)) ≜ (X->includes⇩S⇩e⇩t(y))"
proof -
have C : "⌊⌊insert (x τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def)
show ?thesis
apply(subst OclIncludes_def,
simp add: def_X[simplified OclValid_def] val_x[simplified OclValid_def]
val_y[simplified OclValid_def] foundation10[simplified OclValid_def]
OclValid_def StrongEq_def)
apply(simp add: OclIncluding_def OclIncludes_def def_X[simplified OclValid_def]
val_x[simplified OclValid_def] val_y[simplified OclValid_def]
Abs_Set⇩b⇩a⇩s⇩e_inverse[OF C] true_def)
by(metis foundation22 foundation6 foundation9 neq)
qed
text‹Here is again a generic theorem similar as above.›
lemma OclIncludes_execute_generic:
assumes strict1: "(invalid ≐ y) = invalid"
and strict2: "(x ≐ invalid) = invalid"
and cp_StrictRefEq: "⋀ (X::('𝔄,'a::null)val) Y τ. (X ≐ Y) τ = ((λ_. X τ) ≐ (λ_. Y τ)) τ"
and StrictRefEq_vs_StrongEq: "⋀ (x::('𝔄,'a::null)val) y τ.
τ ⊨ υ x ⟹ τ ⊨ υ y ⟹ (τ ⊨ ((x ≐ y) ≜ (x ≜ y)))"
shows
"(X->including⇩S⇩e⇩t(x::('𝔄,'a::null)val)->includes⇩S⇩e⇩t(y)) =
(if δ X then if x ≐ y then true else X->includes⇩S⇩e⇩t(y) endif else invalid endif)"
proof -
have A: "⋀τ. τ ⊨ (X ≜ invalid) ⟹
(X->including⇩S⇩e⇩t(x)->includes⇩S⇩e⇩t(y)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev,simp,simp)
have B: "⋀τ. τ ⊨ (X ≜ null) ⟹
(X->including⇩S⇩e⇩t(x)->includes⇩S⇩e⇩t(y)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev,simp,simp)
note [simp] = cp_StrictRefEq [THEN allI[THEN allI[THEN allI[THEN cpI2]], of "StrictRefEq"]]
have C: "⋀τ. τ ⊨ (x ≜ invalid) ⟹
(X->including⇩S⇩e⇩t(x)->includes⇩S⇩e⇩t(y)) τ =
(if x ≐ y then true else X->includes⇩S⇩e⇩t(y) endif) τ"
apply(rule foundation22[THEN iffD1])
apply(erule StrongEq_L_subst2_rev,simp,simp)
by (simp add: strict1)
have D:"⋀τ. τ ⊨ (y ≜ invalid) ⟹
(X->including⇩S⇩e⇩t(x)->includes⇩S⇩e⇩t(y)) τ =
(if x ≐ y then true else X->includes⇩S⇩e⇩t(y) endif) τ"
apply(rule foundation22[THEN iffD1])
apply(erule StrongEq_L_subst2_rev,simp,simp)
by (simp add: strict2)
have E: "⋀τ. τ ⊨ υ x ⟹ τ ⊨ υ y ⟹
(if x ≐ y then true else X->includes⇩S⇩e⇩t(y) endif) τ =
(if x ≜ y then true else X->includes⇩S⇩e⇩t(y) endif) τ"
apply(subst cp_OclIf)
apply(subst StrictRefEq_vs_StrongEq[THEN foundation22[THEN iffD1]])
by(simp_all add: cp_OclIf[symmetric])
have F: "⋀τ. τ ⊨ (x ≜ y) ⟹
(X->including⇩S⇩e⇩t(x)->includes⇩S⇩e⇩t(y)) τ = (X->including⇩S⇩e⇩t(x)->includes⇩S⇩e⇩t(x)) τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev,simp, simp)
show ?thesis
apply(rule ext, rename_tac "τ")
apply(case_tac "¬ (τ ⊨ (δ X))", simp add:defined_split,elim disjE A B)
apply(case_tac "¬ (τ ⊨ (υ x))",
simp add:foundation18 foundation22[symmetric],
drule StrongEq_L_sym)
apply(simp add: foundation22 C)
apply(case_tac "¬ (τ ⊨ (υ y))",
simp add:foundation18 foundation22[symmetric],
drule StrongEq_L_sym, simp add: foundation22 D, simp)
apply(subst E,simp_all)
apply(case_tac "τ ⊨ not(x ≜ y)")
apply(simp add: OclIncludes_charn2[simplified foundation22])
apply(simp add: foundation9 F
OclIncludes_charn1[THEN foundation13[THEN iffD2],
THEN foundation22[THEN iffD1]])
done
qed
schematic_goal OclIncludes_execute⇩I⇩n⇩t⇩e⇩g⇩e⇩r[simp,code_unfold]: "?X"
by(rule OclIncludes_execute_generic[OF StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.strict1 StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.strict2
StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.cp0
StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.StrictRefEq_vs_StrongEq], simp_all)
schematic_goal OclIncludes_execute⇩B⇩o⇩o⇩l⇩e⇩a⇩n[simp,code_unfold]: "?X"
by(rule OclIncludes_execute_generic[OF StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n.strict1 StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n.strict2
StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n.cp0
StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n.StrictRefEq_vs_StrongEq], simp_all)
schematic_goal OclIncludes_execute⇩S⇩e⇩t[simp,code_unfold]: "?X"
by(rule OclIncludes_execute_generic[OF StrictRefEq⇩S⇩e⇩t.strict1 StrictRefEq⇩S⇩e⇩t.strict2
StrictRefEq⇩S⇩e⇩t.cp0
StrictRefEq⇩S⇩e⇩t.StrictRefEq_vs_StrongEq], simp_all)
lemma OclIncludes_including_generic :
assumes OclIncludes_execute_generic [simp] : "⋀X x y.
(X->including⇩S⇩e⇩t(x::('𝔄,'a::null)val)->includes⇩S⇩e⇩t(y)) =
(if δ X then if x ≐ y then true else X->includes⇩S⇩e⇩t(y) endif else invalid endif)"
and StrictRefEq_strict'' : "⋀x y. δ ((x::('𝔄,'a::null)val) ≐ y) = (υ(x) and υ(y))"
and a_val : "τ ⊨ υ a"
and x_val : "τ ⊨ υ x"
and S_incl : "τ ⊨ (S)->includes⇩S⇩e⇩t((x::('𝔄,'a::null)val))"
shows "τ ⊨ S->including⇩S⇩e⇩t((a::('𝔄,'a::null)val))->includes⇩S⇩e⇩t(x)"
proof -
have discr_eq_bot1_true : "⋀τ. (⊥ τ = true τ) = False"
by (metis bot_fun_def foundation1 foundation18' valid3)
have discr_eq_bot2_true : "⋀τ. (⊥ = true τ) = False"
by (metis bot_fun_def discr_eq_bot1_true)
have discr_neq_invalid_true : "⋀τ. (invalid τ ≠ true τ) = True"
by (metis discr_eq_bot2_true invalid_def)
have discr_eq_invalid_true : "⋀τ. (invalid τ = true τ) = False"
by (metis bot_option_def invalid_def option.simps(2) true_def)
show ?thesis
apply(simp)
apply(subgoal_tac "τ ⊨ δ S")
prefer 2
apply(insert S_incl[simplified OclIncludes_def], simp add: OclValid_def)
apply(metis discr_eq_bot2_true)
apply(simp add: cp_OclIf[of "δ S"] OclValid_def OclIf_def x_val[simplified OclValid_def]
discr_neq_invalid_true discr_eq_invalid_true)
by (metis OclValid_def S_incl StrictRefEq_strict'' a_val foundation10 foundation6 x_val)
qed
lemmas OclIncludes_including⇩I⇩n⇩t⇩e⇩g⇩e⇩r =
OclIncludes_including_generic[OF OclIncludes_execute⇩I⇩n⇩t⇩e⇩g⇩e⇩r StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.def_homo]
subsubsection‹Execution Rules on Excludes›
lemma OclExcludes_charn1:
assumes def_X:"τ ⊨ (δ X)"
assumes val_x:"τ ⊨ (υ x)"
shows "τ ⊨ (X->excluding⇩S⇩e⇩t(x)->excludes⇩S⇩e⇩t(x))"
proof -
let ?OclSet = "λS. ⌊⌊S⌋⌋ ∈ {X. X = ⊥ ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ ⊥)}"
have diff_in_Set⇩b⇩a⇩s⇩e : "?OclSet (⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ - {x τ})"
apply(simp, (rule disjI2)+)
by (metis (hide_lams, no_types) Diff_iff Set_inv_lemma def_X)
show ?thesis
apply(subst OclExcludes_def, simp add: foundation10[simplified OclValid_def] OclValid_def
def_X[simplified OclValid_def] val_x[simplified OclValid_def])
apply(subst OclIncludes_def, simp add: OclNot_def)
apply(simp add: OclExcluding_def def_X[simplified OclValid_def] val_x[simplified OclValid_def]
Abs_Set⇩b⇩a⇩s⇩e_inverse[OF diff_in_Set⇩b⇩a⇩s⇩e] true_def)
by(simp add: OclAnd_def def_X[simplified OclValid_def] val_x[simplified OclValid_def] true_def)
qed
subsubsection‹Execution Rules on Size›
lemma [simp,code_unfold]: "Set{} ->size⇩S⇩e⇩t() = 𝟬"
apply(rule ext)
apply(simp add: defined_def mtSet_def OclSize_def
bot_Set⇩b⇩a⇩s⇩e_def bot_fun_def
null_Set⇩b⇩a⇩s⇩e_def null_fun_def)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inject, simp_all add: bot_option_def null_option_def) +
by(simp add: Abs_Set⇩b⇩a⇩s⇩e_inverse bot_option_def null_option_def OclInt0_def)
lemma OclSize_including_exec[simp,code_unfold]:
"((X ->including⇩S⇩e⇩t(x)) ->size⇩S⇩e⇩t()) = (if δ X and υ x then
X ->size⇩S⇩e⇩t() +⇩i⇩n⇩t if X ->includes⇩S⇩e⇩t(x) then 𝟬 else 𝟭 endif
else
invalid
endif)"
proof -
have valid_inject_true : "⋀τ P. (υ P) τ ≠ true τ ⟹ (υ P) τ = false τ"
apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def
null_fun_def null_option_def)
by (case_tac "P τ = ⊥", simp_all add: true_def)
have defined_inject_true : "⋀τ P. (δ P) τ ≠ true τ ⟹ (δ P) τ = false τ"
apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def
null_fun_def null_option_def)
by (case_tac " P τ = ⊥ ∨ P τ = null", simp_all add: true_def)
show ?thesis
apply(rule ext, rename_tac τ)
proof -
fix τ
have includes_notin: "¬ τ ⊨ X->includes⇩S⇩e⇩t(x) ⟹ (δ X) τ = true τ ∧ (υ x) τ = true τ ⟹
x τ ∉ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
by(simp add: OclIncludes_def OclValid_def true_def)
have includes_def: "τ ⊨ X->includes⇩S⇩e⇩t(x) ⟹ τ ⊨ δ X"
by (metis bot_fun_def OclIncludes_def OclValid_def defined3 foundation16)
have includes_val: "τ ⊨ X->includes⇩S⇩e⇩t(x) ⟹ τ ⊨ υ x"
using foundation5 foundation6 by fastforce
have ins_in_Set⇩b⇩a⇩s⇩e: "τ ⊨ δ X ⟹ τ ⊨ υ x ⟹
⌊⌊insert (x τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉⌋⌋ ∈ {X. X = ⊥ ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ ⊥)}"
apply(simp add: bot_option_def null_option_def)
by (metis (hide_lams, no_types) Set_inv_lemma foundation18' foundation5)
have m : "⋀τ. (λ_. ⊥) = (λ_. invalid τ)" by(rule ext, simp add:invalid_def)
show "X->including⇩S⇩e⇩t(x)->size⇩S⇩e⇩t() τ = (if δ X and υ x
then X->size⇩S⇩e⇩t() +⇩i⇩n⇩t if X->includes⇩S⇩e⇩t(x) then 𝟬 else 𝟭 endif
else invalid endif) τ"
apply(case_tac "τ ⊨ δ X and υ x", simp)
apply(subst OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r.cp0)
apply(case_tac "τ ⊨ X->includes⇩S⇩e⇩t(x)", simp add: OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r.cp0[symmetric])
apply(case_tac "τ ⊨ ((υ (X->size⇩S⇩e⇩t())) and not (δ (X->size⇩S⇩e⇩t())))", simp)
apply(drule foundation5[where P = "υ X->size⇩S⇩e⇩t()"], erule conjE)
apply(drule OclSize_infinite)
apply(frule includes_def, drule includes_val, simp)
apply(subst OclSize_def, subst OclIncluding_finite_rep_set, assumption+)
apply (metis (hide_lams, no_types) invalid_def)
apply(subst OclIf_false',
metis (hide_lams, no_types) defined5 defined6 defined_and_I defined_not_I
foundation1 foundation9)
apply(subst cp_OclSize, simp add: OclIncluding_includes0 cp_OclSize[symmetric])
apply(subst OclIf_false', subst foundation9, auto, simp add: OclSize_def)
apply(drule foundation5)
apply(subst (1 2) OclIncluding_finite_rep_set, fast+)
apply(subst (1 2) cp_OclAnd, subst (1 2) OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r.cp0, simp)
apply(rule conjI)
apply(simp add: OclIncluding_def)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse[OF ins_in_Set⇩b⇩a⇩s⇩e], fast+)
apply(subst (asm) (2 3) OclValid_def, simp add: OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r_def OclInt1_def)
apply(rule impI)
apply(drule Finite_Set.card.insert[where x = "x τ"])
apply(rule includes_notin, simp, simp)
apply (metis Suc_eq_plus1 of_nat_1 of_nat_add)
apply(subst (1 2) m[of τ], simp only: OclAdd⇩I⇩n⇩t⇩e⇩g⇩e⇩r.cp0[symmetric],simp, simp add:invalid_def)
apply(subst OclIncluding_finite_rep_set, fast+, simp add: OclValid_def)
apply(subst OclIf_false', metis (hide_lams, no_types) defined6 foundation1 foundation9
OclExcluding_valid_args_valid'')
by (metis cp_OclSize foundation18' OclIncluding_valid_args_valid'' invalid_def OclSize_invalid)
qed
qed
subsubsection‹Execution Rules on IsEmpty›
lemma [simp,code_unfold]: "Set{}->isEmpty⇩S⇩e⇩t() = true"
by(simp add: OclIsEmpty_def)
lemma OclIsEmpty_including [simp]:
assumes X_def: "τ ⊨ δ X"
and X_finite: "finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
and a_val: "τ ⊨ υ a"
shows "X->including⇩S⇩e⇩t(a)->isEmpty⇩S⇩e⇩t() τ = false τ"
proof -
have A1 : "⋀τ X. X τ = true τ ∨ X τ = false τ ⟹ (X and not X) τ = false τ"
by (metis (no_types) OclAnd_false1 OclAnd_idem OclImplies_def OclNot3 OclNot_not OclOr_false1
cp_OclAnd cp_OclNot deMorgan1 deMorgan2)
have defined_inject_true : "⋀τ P. (δ P) τ ≠ true τ ⟹ (δ P) τ = false τ"
apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def
null_fun_def null_option_def)
by (case_tac " P τ = ⊥ ∨ P τ = null", simp_all add: true_def)
have B : "⋀X τ. τ ⊨ υ X ⟹ X τ ≠ 𝟬 τ ⟹ (X ≐ 𝟬) τ = false τ"
apply(simp add: foundation22[symmetric] foundation14 foundation9)
apply(erule StrongEq_L_subst4_rev[THEN iffD2, OF StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.StrictRefEq_vs_StrongEq])
by(simp_all)
show ?thesis
apply(simp add: OclIsEmpty_def del: OclSize_including_exec)
apply(subst cp_OclOr, subst A1)
apply (metis OclExcludes.def_homo defined_inject_true)
apply(simp add: cp_OclOr[symmetric] del: OclSize_including_exec)
apply(rule B,
rule foundation20,
metis OclIncluding.def_homo OclIncluding_finite_rep_set X_def X_finite a_val foundation10' size_defined')
apply(simp add: OclSize_def OclIncluding_finite_rep_set[OF X_def a_val] X_finite OclInt0_def)
by (metis OclValid_def X_def a_val foundation10 foundation6
OclIncluding_notempty_rep_set[OF X_def a_val])
qed
subsubsection‹Execution Rules on NotEmpty›
lemma [simp,code_unfold]: "Set{}->notEmpty⇩S⇩e⇩t() = false"
by(simp add: OclNotEmpty_def)
lemma OclNotEmpty_including [simp,code_unfold]:
assumes X_def: "τ ⊨ δ X"
and X_finite: "finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
and a_val: "τ ⊨ υ a"
shows "X->including⇩S⇩e⇩t(a)->notEmpty⇩S⇩e⇩t() τ = true τ"
apply(simp add: OclNotEmpty_def)
apply(subst cp_OclNot, subst OclIsEmpty_including, simp_all add: assms)
by (metis OclNot4 cp_OclNot)
subsubsection‹Execution Rules on Any›
lemma [simp,code_unfold]: "Set{}->any⇩S⇩e⇩t() = null"
by(rule ext, simp add: OclANY_def, simp add: false_def true_def)
lemma OclANY_singleton_exec[simp,code_unfold]:
"(Set{}->including⇩S⇩e⇩t(a))->any⇩S⇩e⇩t() = a"
apply(rule ext, rename_tac τ, simp add: mtSet_def OclANY_def)
apply(case_tac "τ ⊨ υ a")
apply(simp add: OclValid_def mtSet_defined[simplified mtSet_def]
mtSet_valid[simplified mtSet_def] mtSet_rep_set[simplified mtSet_def])
apply(subst (1 2) cp_OclAnd,
subst (1 2) OclNotEmpty_including[where X = "Set{}", simplified mtSet_def])
apply(simp add: mtSet_defined[simplified mtSet_def])
apply(metis (hide_lams, no_types) finite.emptyI mtSet_def mtSet_rep_set)
apply(simp add: OclValid_def)
apply(simp add: OclIncluding_def)
apply(rule conjI)
apply(subst (1 2) Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def null_option_def)
apply(simp, metis OclValid_def foundation18')
apply(simp)
apply(simp add: mtSet_defined[simplified mtSet_def])
apply(subgoal_tac "a τ = ⊥")
prefer 2
apply(simp add: OclValid_def valid_def bot_fun_def split: if_split_asm)
apply(simp)
apply(subst (1 2 3 4) cp_OclAnd,
simp add: mtSet_defined[simplified mtSet_def] valid_def bot_fun_def)
by(simp add: cp_OclAnd[symmetric], rule impI, simp add: false_def true_def)
subsubsection‹Execution Rules on Forall›
lemma OclForall_mtSet_exec[simp,code_unfold] :"((Set{})->forAll⇩S⇩e⇩t(z| P(z))) = true"
apply(simp add: OclForall_def)
apply(subst mtSet_def)+
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp_all add: true_def)+
done
text‹The following rule is a main theorem of our approach: From a denotational definition
that assures consistency, but may be --- as in the case of the @{term "X->forAll⇩S⇩e⇩t(x | P x)"} ---
dauntingly complex, we derive operational rules that can serve as a gold-standard for operational
execution, since they may be evaluated in whatever situation and according to whatever strategy.
In the case of @{term "X->forAll⇩S⇩e⇩t(x | P x)"}, the operational rule gives immediately a way to
evaluation in any finite (in terms of conventional OCL: denotable) set, although the rule also
holds for the infinite case:
@{term "Integer⇩n⇩u⇩l⇩l ->forAll⇩S⇩e⇩t(x | (Integer⇩n⇩u⇩l⇩l ->forAll⇩S⇩e⇩t(y | x +⇩i⇩n⇩t y ≜ y +⇩i⇩n⇩t x)))"}
or even:
@{term "Integer ->forAll⇩S⇩e⇩t(x | (Integer ->forAll⇩S⇩e⇩t(y | x +⇩i⇩n⇩t y ≐ y +⇩i⇩n⇩t x)))"}
are valid OCL statements in any context $\tau$.
›
theorem OclForall_including_exec[simp,code_unfold] :
assumes cp0 : "cp P"
shows "((S->including⇩S⇩e⇩t(x))->forAll⇩S⇩e⇩t(z | P(z))) = (if δ S and υ x
then P x and (S->forAll⇩S⇩e⇩t(z | P(z)))
else invalid
endif)"
proof -
have cp: "⋀τ. P x τ = P (λ_. x τ) τ" by(insert cp0, auto simp: cp_def)
have cp_eq : "⋀τ v. (P x τ = v) = (P (λ_. x τ) τ = v)" by(subst cp, simp)
have cp_OclNot_eq : "⋀τ v. (P x τ ≠ v) = (P (λ_. x τ) τ ≠ v)" by(subst cp, simp)
have insert_in_Set⇩b⇩a⇩s⇩e : "⋀τ. (τ ⊨(δ S)) ⟹ (τ ⊨(υ x)) ⟹
⌊⌊insert (x τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉⌋⌋ ∈
{X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(frule Set_inv_lemma, simp add: foundation18 invalid_def)
have forall_including_invert : "⋀τ f. (f x τ = f (λ _. x τ) τ) ⟹
τ ⊨ (δ S and υ x) ⟹
(∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S->including⇩S⇩e⇩t(x) τ)⌉⌉. f (λ_. x) τ) =
(f x τ ∧ (∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉. f (λ_. x) τ))"
apply(drule foundation5, simp add: OclIncluding_def)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse)
apply(rule insert_in_Set⇩b⇩a⇩s⇩e, fast+)
by(simp add: OclValid_def)
have exists_including_invert : "⋀τ f. (f x τ = f (λ _. x τ) τ) ⟹
τ ⊨ (δ S and υ x) ⟹
(∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S->including⇩S⇩e⇩t(x) τ)⌉⌉. f (λ_. x) τ) =
(f x τ ∨ (∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉. f (λ_. x) τ))"
apply(subst arg_cong[where f = "λx. ¬x",
OF forall_including_invert[where f = "λx τ. ¬ (f x τ)"],
simplified])
by simp_all
have contradict_Rep_Set⇩b⇩a⇩s⇩e: "⋀τ S f. ∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e S⌉⌉. f (λ_. x) τ ⟹
(∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e S⌉⌉. ¬ (f (λ_. x) τ)) = False"
by(case_tac "(∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e S⌉⌉. ¬ (f (λ_. x) τ)) = True", simp_all)
have bot_invalid : "⊥ = invalid" by(rule ext, simp add: invalid_def bot_fun_def)
have bot_invalid2 : "⋀τ. ⊥ = invalid τ" by(simp add: invalid_def)
have C1 : "⋀τ. P x τ = false τ ∨ (∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉. P (λ_. x) τ = false τ) ⟹
τ ⊨ (δ S and υ x) ⟹
false τ = (P x and OclForall S P) τ"
apply(simp add: cp_OclAnd[of "P x"])
apply(elim disjE, simp)
apply(simp only: cp_OclAnd[symmetric], simp)
apply(subgoal_tac "OclForall S P τ = false τ")
apply(simp only: cp_OclAnd[symmetric], simp)
apply(simp add: OclForall_def)
apply(fold OclValid_def, simp add: foundation10')
done
have C2 : "⋀τ. τ ⊨ (δ S and υ x) ⟹
P x τ = null τ ∨ (∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉. P (λ_. x) τ = null τ) ⟹
P x τ = invalid τ ∨ (∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉. P (λ_. x) τ = invalid τ) ⟹
∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S->including⇩S⇩e⇩t(x) τ)⌉⌉. P (λ_. x) τ ≠ false τ ⟹
invalid τ = (P x and OclForall S P) τ"
apply(subgoal_tac "(δ S)τ = true τ")
prefer 2 apply(simp add: foundation10', simp add: OclValid_def)
apply(drule forall_including_invert[of "λ x τ. P x τ ≠ false τ", OF cp_OclNot_eq, THEN iffD1])
apply(assumption)
apply(simp add: cp_OclAnd[of "P x"],elim disjE, simp_all)
apply(simp add: invalid_def null_fun_def null_option_def bot_fun_def bot_option_def)
apply(subgoal_tac "OclForall S P τ = invalid τ")
apply(simp only:cp_OclAnd[symmetric],simp,simp add:invalid_def bot_fun_def)
apply(unfold OclForall_def, simp add: invalid_def false_def bot_fun_def,simp)
apply(simp add:cp_OclAnd[symmetric],simp)
apply(erule conjE)
apply(subgoal_tac "(P x τ = invalid τ) ∨ (P x τ = null τ) ∨ (P x τ = true τ) ∨ (P x τ = false τ)")
prefer 2 apply(rule bool_split_0)
apply(elim disjE, simp_all)
apply(simp only:cp_OclAnd[symmetric],simp)+
done
have A : "⋀τ. τ ⊨ (δ S and υ x) ⟹
OclForall (S->including⇩S⇩e⇩t(x)) P τ = (P x and OclForall S P) τ"
proof - fix τ
assume 0 : "τ ⊨ (δ S and υ x)"
let ?S = "λocl. P x τ ≠ ocl τ ∧ (∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉. P (λ_. x) τ ≠ ocl τ)"
let ?S' = "λocl. ∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S->including⇩S⇩e⇩t(x) τ)⌉⌉. P (λ_. x) τ ≠ ocl τ"
let ?assms_1 = "?S' null"
let ?assms_2 = "?S' invalid"
let ?assms_3 = "?S' false"
have 4 : "?assms_3 ⟹ ?S false"
apply(subst forall_including_invert[of "λ x τ. P x τ ≠ false τ",symmetric])
by(simp_all add: cp_OclNot_eq 0)
have 5 : "?assms_2 ⟹ ?S invalid"
apply(subst forall_including_invert[of "λ x τ. P x τ ≠ invalid τ",symmetric])
by(simp_all add: cp_OclNot_eq 0)
have 6 : "?assms_1 ⟹ ?S null"
apply(subst forall_including_invert[of "λ x τ. P x τ ≠ null τ",symmetric])
by(simp_all add: cp_OclNot_eq 0)
have 7 : "(δ S) τ = true τ"
by(insert 0, simp add: foundation10', simp add: OclValid_def)
show "?thesis τ"
apply(subst OclForall_def)
apply(simp add: cp_OclAnd[THEN sym] OclValid_def contradict_Rep_Set⇩b⇩a⇩s⇩e)
apply(intro conjI impI,fold OclValid_def)
apply(simp_all add: exists_including_invert[where f = "λ x τ. P x τ = null τ", OF cp_eq])
apply(simp_all add: exists_including_invert[where f = "λ x τ. P x τ = invalid τ", OF cp_eq])
apply(simp_all add: exists_including_invert[where f = "λ x τ. P x τ = false τ", OF cp_eq])
proof -
assume 1 : "P x τ = null τ ∨ (∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉. P (λ_. x) τ = null τ)"
and 2 : ?assms_2
and 3 : ?assms_3
show "null τ = (P x and OclForall S P) τ"
proof -
note 4 = 4[OF 3]
note 5 = 5[OF 2]
have 6 : "P x τ = null τ ∨ P x τ = true τ"
by(metis 4 5 bool_split_0)
show ?thesis
apply(insert 6, elim disjE)
apply(subst cp_OclAnd)
apply(simp add: OclForall_def 7 4[THEN conjunct2] 5[THEN conjunct2])
apply(simp_all add:cp_OclAnd[symmetric])
apply(subst cp_OclAnd, simp_all add:cp_OclAnd[symmetric] OclForall_def)
apply(simp add:4[THEN conjunct2] 5[THEN conjunct2] 0[simplified OclValid_def] 7)
apply(insert 1, elim disjE, auto)
done
qed
next
assume 1 : ?assms_1
and 2 : "P x τ = invalid τ ∨ (∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉. P (λ_. x) τ = invalid τ)"
and 3 : ?assms_3
show "invalid τ = (P x and OclForall S P) τ"
proof -
note 4 = 4[OF 3]
note 6 = 6[OF 1]
have 5 : "P x τ = invalid τ ∨ P x τ = true τ"
by(metis 4 6 bool_split_0)
show ?thesis
apply(insert 5, elim disjE)
apply(subst cp_OclAnd)
apply(simp add: OclForall_def 4[THEN conjunct2] 6[THEN conjunct2] 7)
apply(simp_all add:cp_OclAnd[symmetric])
apply(subst cp_OclAnd, simp_all add:cp_OclAnd[symmetric] OclForall_def)
apply(insert 2, elim disjE, simp add: invalid_def true_def bot_option_def)
apply(simp add: 0[simplified OclValid_def] 4[THEN conjunct2] 6[THEN conjunct2] 7)
by(auto)
qed
next
assume 1 : ?assms_1
and 2 : ?assms_2
and 3 : ?assms_3
show "true τ = (P x and OclForall S P) τ"
proof -
note 4 = 4[OF 3]
note 5 = 5[OF 2]
note 6 = 6[OF 1]
have 8 : "P x τ = true τ"
by(metis 4 5 6 bool_split_0)
show ?thesis
apply(subst cp_OclAnd, simp add: 8 cp_OclAnd[symmetric])
by(simp add: OclForall_def 4 5 6 7)
qed
qed ( simp add: 0
| rule C1, simp+
| rule C2, simp add: 0 )+
qed
have B : "⋀τ. ¬ (τ ⊨ (δ S and υ x)) ⟹
OclForall (S->including⇩S⇩e⇩t(x)) P τ = invalid τ"
apply(rule foundation22[THEN iffD1])
apply(simp only: foundation10' de_Morgan_conj foundation18'', elim disjE)
apply(simp add: defined_split, elim disjE)
apply(erule StrongEq_L_subst2_rev, simp+)+
done
show ?thesis
apply(rule ext, rename_tac τ)
apply(simp add: OclIf_def)
apply(simp add: cp_defined[of "δ S and υ x"] cp_defined[THEN sym])
apply(intro conjI impI)
by(auto intro!: A B simp: OclValid_def)
qed
subsubsection‹Execution Rules on Exists›
lemma OclExists_mtSet_exec[simp,code_unfold] :
"((Set{})->exists⇩S⇩e⇩t(z | P(z))) = false"
by(simp add: OclExists_def)
lemma OclExists_including_exec[simp,code_unfold] :
assumes cp: "cp P"
shows "((S->including⇩S⇩e⇩t(x))->exists⇩S⇩e⇩t(z | P(z))) = (if δ S and υ x
then P x or (S->exists⇩S⇩e⇩t(z | P(z)))
else invalid
endif)"
by(simp add: OclExists_def OclOr_def cp OclNot_inject)
subsubsection‹Execution Rules on Iterate›
lemma OclIterate_empty[simp,code_unfold]: "((Set{})->iterate⇩S⇩e⇩t(a; x = A | P a x)) = A"
proof -
have C : "⋀ τ. (δ (λτ. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊{}⌋⌋)) τ = true τ"
by (metis (no_types) defined_def mtSet_def mtSet_defined null_fun_def)
show ?thesis
apply(simp add: OclIterate_def mtSet_def Abs_Set⇩b⇩a⇩s⇩e_inverse valid_def C)
apply(rule ext, rename_tac τ)
apply(case_tac "A τ = ⊥ τ", simp_all, simp add:true_def false_def bot_fun_def)
apply(simp add: Abs_Set⇩b⇩a⇩s⇩e_inverse)
done
qed
text‹In particular, this does hold for A = null.›
lemma OclIterate_including:
assumes S_finite: "τ ⊨ δ(S->size⇩S⇩e⇩t())"
and F_valid_arg: "(υ A) τ = (υ (F a A)) τ"
and F_commute: "comp_fun_commute F"
and F_cp: "⋀ x y τ. F x y τ = F (λ _. x τ) y τ"
shows "((S->including⇩S⇩e⇩t(a))->iterate⇩S⇩e⇩t(a; x = A | F a x)) τ =
((S->excluding⇩S⇩e⇩t(a))->iterate⇩S⇩e⇩t(a; x = F a A | F a x)) τ"
proof -
have insert_in_Set⇩b⇩a⇩s⇩e : "⋀τ. (τ ⊨(δ S)) ⟹ (τ ⊨(υ a)) ⟹
⌊⌊insert (a τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(frule Set_inv_lemma, simp add: foundation18 invalid_def)
have insert_defined : "⋀τ. (τ ⊨(δ S)) ⟹ (τ ⊨(υ a)) ⟹
(δ (λ_. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊insert (a τ) ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉⌋⌋)) τ = true τ"
apply(subst defined_def)
apply(simp add: bot_Set⇩b⇩a⇩s⇩e_def bot_fun_def null_Set⇩b⇩a⇩s⇩e_def null_fun_def)
by(subst Abs_Set⇩b⇩a⇩s⇩e_inject,
rule insert_in_Set⇩b⇩a⇩s⇩e, simp_all add: null_option_def bot_option_def)+
have remove_finite : "finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ ⟹
finite ((λa τ. a) ` (⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ - {a τ}))"
by(simp)
have remove_in_Set⇩b⇩a⇩s⇩e : "⋀τ. (τ ⊨(δ S)) ⟹ (τ ⊨(υ a)) ⟹
⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ - {a τ}⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)}"
by(frule Set_inv_lemma, simp add: foundation18 invalid_def)
have remove_defined : "⋀τ. (τ ⊨(δ S)) ⟹ (τ ⊨(υ a)) ⟹
(δ (λ_. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ - {a τ}⌋⌋)) τ = true τ"
apply(subst defined_def)
apply(simp add: bot_Set⇩b⇩a⇩s⇩e_def bot_fun_def null_Set⇩b⇩a⇩s⇩e_def null_fun_def)
by(subst Abs_Set⇩b⇩a⇩s⇩e_inject,
rule remove_in_Set⇩b⇩a⇩s⇩e, simp_all add: null_option_def bot_option_def)+
have abs_rep: "⋀x. ⌊⌊x⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ bot)} ⟹
⌈⌈Rep_Set⇩b⇩a⇩s⇩e (Abs_Set⇩b⇩a⇩s⇩e ⌊⌊x⌋⌋)⌉⌉ = x"
by(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp_all)
have inject : "inj (λa τ. a)"
by(rule inj_fun, simp)
show ?thesis
apply(subst (1 2) cp_OclIterate, subst OclIncluding_def, subst OclExcluding_def)
apply(case_tac "¬ ((δ S) τ = true τ ∧ (υ a) τ = true τ)", simp add: invalid_def)
apply(subgoal_tac "OclIterate (λ_. ⊥) A F τ = OclIterate (λ_. ⊥) (F a A) F τ", simp)
apply(rule conjI, blast+)
apply(simp add: OclIterate_def defined_def bot_option_def bot_fun_def false_def true_def)
apply(simp add: OclIterate_def)
apply((subst abs_rep[OF insert_in_Set⇩b⇩a⇩s⇩e[simplified OclValid_def], of τ], simp_all)+,
(subst abs_rep[OF remove_in_Set⇩b⇩a⇩s⇩e[simplified OclValid_def], of τ], simp_all)+,
(subst insert_defined, simp_all add: OclValid_def)+,
(subst remove_defined, simp_all add: OclValid_def)+)
apply(case_tac "¬ ((υ A) τ = true τ)", (simp add: F_valid_arg)+)
apply(rule impI,
subst Finite_Set.comp_fun_commute.fold_fun_left_comm[symmetric, OF F_commute],
rule remove_finite, simp)
apply(subst image_set_diff[OF inject], simp)
apply(subgoal_tac "Finite_Set.fold F A (insert (λτ'. a τ) ((λa τ. a) ` ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉)) τ =
F (λτ'. a τ) (Finite_Set.fold F A ((λa τ. a) ` ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ - {λτ'. a τ})) τ")
apply(subst F_cp, simp)
by(subst Finite_Set.comp_fun_commute.fold_insert_remove[OF F_commute], simp+)
qed
subsubsection‹Execution Rules on Select›
lemma OclSelect_mtSet_exec[simp,code_unfold]: "OclSelect mtSet P = mtSet"
apply(rule ext, rename_tac τ)
apply(simp add: OclSelect_def mtSet_def defined_def false_def true_def
bot_Set⇩b⇩a⇩s⇩e_def bot_fun_def null_Set⇩b⇩a⇩s⇩e_def null_fun_def)
by(( subst (1 2 3 4 5) Abs_Set⇩b⇩a⇩s⇩e_inverse
| subst Abs_Set⇩b⇩a⇩s⇩e_inject), (simp add: null_option_def bot_option_def)+)+
definition "OclSelect_body :: _ ⇒ _ ⇒ _ ⇒ ('𝔄, 'a option option) Set
≡ (λP x acc. if P x ≐ false then acc else acc->including⇩S⇩e⇩t(x) endif)"
theorem OclSelect_including_exec[simp,code_unfold]:
assumes P_cp : "cp P"
shows "OclSelect (X->including⇩S⇩e⇩t(y)) P = OclSelect_body P y (OclSelect (X->excluding⇩S⇩e⇩t(y)) P)"
(is "_ = ?select")
proof -
have P_cp: "⋀x τ. P x τ = P (λ_. x τ) τ" by(insert P_cp, auto simp: cp_def)
have ex_including : "⋀f X y τ. τ ⊨ δ X ⟹ τ ⊨ υ y ⟹
(∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->including⇩S⇩e⇩t(y) τ)⌉⌉. f (P (λ_. x)) τ) =
(f (P (λ_. y τ)) τ ∨ (∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. f (P (λ_. x)) τ))"
apply(simp add: OclIncluding_def OclValid_def)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp, (rule disjI2)+)
by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18',simp)
have al_including : "⋀f X y τ. τ ⊨ δ X ⟹ τ ⊨ υ y ⟹
(∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->including⇩S⇩e⇩t(y) τ)⌉⌉. f (P (λ_. x)) τ) =
(f (P (λ_. y τ)) τ ∧ (∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. f (P (λ_. x)) τ))"
apply(simp add: OclIncluding_def OclValid_def)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp, (rule disjI2)+)
by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18', simp)
have ex_excluding1 : "⋀f X y τ. τ ⊨ δ X ⟹ τ ⊨ υ y ⟹ ¬ (f (P (λ_. y τ)) τ) ⟹
(∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. f (P (λ_. x)) τ) =
(∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->excluding⇩S⇩e⇩t(y) τ)⌉⌉. f (P (λ_. x)) τ)"
apply(simp add: OclExcluding_def OclValid_def)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp, (rule disjI2)+)
by (metis (no_types) Diff_iff OclValid_def Set_inv_lemma) auto
have al_excluding1 : "⋀f X y τ. τ ⊨ δ X ⟹ τ ⊨ υ y ⟹ f (P (λ_. y τ)) τ ⟹
(∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. f (P (λ_. x)) τ) =
(∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->excluding⇩S⇩e⇩t(y) τ)⌉⌉. f (P (λ_. x)) τ)"
apply(simp add: OclExcluding_def OclValid_def)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp, (rule disjI2)+)
by (metis (no_types) Diff_iff OclValid_def Set_inv_lemma) auto
have in_including : "⋀f X y τ. τ ⊨ δ X ⟹ τ ⊨ υ y ⟹
{x ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->including⇩S⇩e⇩t(y) τ)⌉⌉. f (P (λ_. x) τ)} =
(let s = {x ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. f (P (λ_. x) τ)} in
if f (P (λ_. y τ) τ) then insert (y τ) s else s)"
apply(simp add: OclIncluding_def OclValid_def)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp, (rule disjI2)+)
apply (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18')
by(simp add: Let_def, auto)
let ?OclSet = "λS. ⌊⌊S⌋⌋ ∈ {X. X = ⊥ ∨ X = null ∨ (∀x∈⌈⌈X⌉⌉. x ≠ ⊥)}"
have diff_in_Set⇩b⇩a⇩s⇩e : "⋀τ. (δ X) τ = true τ ⟹ ?OclSet (⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ - {y τ})"
apply(simp, (rule disjI2)+)
by (metis (mono_tags) Diff_iff OclValid_def Set_inv_lemma)
have ins_in_Set⇩b⇩a⇩s⇩e : "⋀τ. (δ X) τ = true τ ⟹ (υ y) τ = true τ ⟹
?OclSet (insert (y τ) {x ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. P (λ_. x) τ ≠ false τ})"
apply(simp, (rule disjI2)+)
by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18')
have ins_in_Set⇩b⇩a⇩s⇩e' : "⋀τ. (δ X) τ = true τ ⟹ (υ y) τ = true τ ⟹
?OclSet (insert (y τ) {x ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. x ≠ y τ ∧ P (λ_. x) τ ≠ false τ})"
apply(simp, (rule disjI2)+)
by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18')
have ins_in_Set⇩b⇩a⇩s⇩e'' : "⋀τ. (δ X) τ = true τ ⟹
?OclSet {x ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. P (λ_. x) τ ≠ false τ}"
apply(simp, (rule disjI2)+)
by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma)
have ins_in_Set⇩b⇩a⇩s⇩e''' : "⋀τ. (δ X) τ = true τ ⟹
?OclSet {x ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. x ≠ y τ ∧ P (λ_. x) τ ≠ false τ}"
apply(simp, (rule disjI2)+)
by(metis (hide_lams, no_types) OclValid_def Set_inv_lemma)
have if_same : "⋀a b c d τ. τ ⊨ δ a ⟹ b τ = d τ ⟹ c τ = d τ ⟹
(if a then b else c endif) τ = d τ"
by(simp add: OclIf_def OclValid_def)
have invert_including : "⋀P y τ. P τ = ⊥ ⟹ P->including⇩S⇩e⇩t(y) τ = ⊥"
by (metis (hide_lams, no_types) foundation16[THEN iffD1]
foundation18' OclIncluding_valid_args_valid)
have exclude_defined : "⋀τ. τ ⊨ δ X ⟹
(δ(λ_. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊{x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. x ≠ y τ ∧ P (λ_. x) τ≠false τ}⌋⌋)) τ = true τ"
apply(subst defined_def,
simp add: false_def true_def bot_Set⇩b⇩a⇩s⇩e_def bot_fun_def null_Set⇩b⇩a⇩s⇩e_def null_fun_def)
by(subst Abs_Set⇩b⇩a⇩s⇩e_inject[OF ins_in_Set⇩b⇩a⇩s⇩e'''[simplified false_def]],
(simp add: OclValid_def bot_option_def null_option_def)+)+
have if_eq : "⋀x A B τ. τ ⊨ υ x ⟹ τ ⊨ ((if x ≐ false then A else B endif) ≜
(if x ≜ false then A else B endif))"
apply(simp add: StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n OclValid_def)
apply(subst (2) StrongEq_def)
by(subst cp_OclIf, simp add: cp_OclIf[symmetric] true_def)
have OclSelect_body_bot: "⋀τ. τ ⊨ δ X ⟹ τ ⊨ υ y ⟹ P y τ ≠ ⊥ ⟹
(∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. P (λ_. x) τ = ⊥) ⟹ ⊥ = ?select τ"
apply(drule ex_excluding1[where X2 = X and y2 = y and f2 = "λx τ. x τ = ⊥"],
(simp add: P_cp[symmetric])+)
apply(subgoal_tac "τ ⊨ (⊥ ≜ ?select)", simp add: OclValid_def StrongEq_def true_def bot_fun_def)
apply(simp add: OclSelect_body_def)
apply(subst StrongEq_L_subst3[OF _ if_eq], simp, metis foundation18')
apply(simp add: OclValid_def, subst StrongEq_def, subst true_def, simp)
apply(subgoal_tac "∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->excluding⇩S⇩e⇩t(y) τ)⌉⌉. P (λ_. x) τ = ⊥ τ")
prefer 2 apply (metis bot_fun_def )
apply(subst if_same[where d5 = "⊥"])
apply (metis defined7 transform1)
apply(simp add: OclSelect_def bot_option_def bot_fun_def invalid_def)
apply(subst invert_including)
by(simp add: OclSelect_def bot_option_def bot_fun_def invalid_def)+
have d_and_v_inject : "⋀τ X y. (δ X and υ y) τ ≠ true τ ⟹ (δ X and υ y) τ = false τ"
apply(fold OclValid_def, subst foundation22[symmetric])
apply(auto simp:foundation10' defined_split)
apply(erule StrongEq_L_subst2_rev,simp,simp)
apply(erule StrongEq_L_subst2_rev,simp,simp)
by(erule foundation7'[THEN iffD2, THEN foundation15[THEN iffD2,
THEN StrongEq_L_subst2_rev]],simp,simp)
have OclSelect_body_bot': "⋀τ. (δ X and υ y) τ ≠ true τ ⟹ ⊥ = ?select τ"
apply(drule d_and_v_inject)
apply(simp add: OclSelect_def OclSelect_body_def)
apply(subst cp_OclIf, subst OclIncluding.cp0, simp add: false_def true_def)
apply(subst cp_OclIf[symmetric], subst OclIncluding.cp0[symmetric])
by (metis (lifting, no_types) OclIf_def foundation18 foundation18' invert_including)
have conj_split2 : "⋀a b c τ. ((a ≜ false) τ = false τ ⟶ b) ∧ ((a ≜ false) τ = true τ ⟶ c) ⟹
(a τ ≠ false τ ⟶ b) ∧ (a τ = false τ ⟶ c)"
by (metis OclValid_def defined7 foundation14 foundation22 foundation9)
have defined_inject_true : "⋀τ P. (δ P) τ ≠ true τ ⟹ (δ P) τ = false τ"
apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def
null_fun_def null_option_def)
by (case_tac " P τ = ⊥ ∨ P τ = null", simp_all add: true_def)
have cp_OclSelect_body : "⋀τ. ?select τ = OclSelect_body P y (λ_.(OclSelect (X->excluding⇩S⇩e⇩t(y))P)τ)τ"
apply(simp add: OclSelect_body_def)
by(subst (1 2) cp_OclIf, subst (1 2) OclIncluding.cp0, blast)
have OclSelect_body_strict1 : "OclSelect_body P y invalid = invalid"
by(rule ext, simp add: OclSelect_body_def OclIf_def)
have bool_invalid: "⋀(x::('𝔄)Boolean) y τ. ¬ (τ ⊨ υ x) ⟹ τ ⊨ ((x ≐ y) ≜ invalid)"
by(simp add: StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n OclValid_def StrongEq_def true_def)
have conj_comm : "⋀p q r. (p ∧ q ∧ r) = ((p ∧ q) ∧ r)" by blast
have inv_bot : "⋀τ. invalid τ = ⊥ τ" by (metis bot_fun_def invalid_def)
have inv_bot' : "⋀τ. invalid τ = ⊥" by (simp add: invalid_def)
show ?thesis
apply(rule ext, rename_tac τ)
apply(subst OclSelect_def)
apply(case_tac "(δ (X->including⇩S⇩e⇩t(y))) τ = true τ", simp)
apply(( subst ex_including | subst in_including),
metis OclValid_def foundation5,
metis OclValid_def foundation5)+
apply(simp add: Let_def inv_bot)
apply(subst (2 4 7 9) bot_fun_def)
apply(subst (4) false_def, subst (4) bot_fun_def, simp add: bot_option_def P_cp[symmetric])
apply(case_tac "¬ (τ ⊨ (υ P y))")
apply(subgoal_tac "P y τ ≠ false τ")
prefer 2
apply (metis (hide_lams, no_types) foundation1 foundation18' valid4)
apply(simp)
apply(subst conj_comm, rule conjI)
apply(drule_tac y11 = false in bool_invalid)
apply(simp only: OclSelect_body_def,
metis OclIf_def OclValid_def defined_def foundation2 foundation22
bot_fun_def invalid_def)
apply(drule foundation5[simplified OclValid_def],
subst al_including[simplified OclValid_def],
simp,
simp)
apply(simp add: P_cp[symmetric])
apply (metis bot_fun_def foundation18')
apply(simp add: foundation18' bot_fun_def OclSelect_body_bot OclSelect_body_bot')
apply(subst (1 2) al_including, metis OclValid_def foundation5, metis OclValid_def foundation5)
apply(simp add: P_cp[symmetric], subst (4) false_def, subst (4) bot_option_def, simp)
apply(simp add: OclSelect_def[simplified inv_bot'] OclSelect_body_def StrictRefEq⇩B⇩o⇩o⇩l⇩e⇩a⇩n)
apply(subst (1 2 3 4) cp_OclIf,
subst (1 2 3 4) foundation18'[THEN iffD2, simplified OclValid_def],
simp,
simp only: cp_OclIf[symmetric] refl if_True)
apply(subst (1 2) OclIncluding.cp0, rule conj_split2, simp add: cp_OclIf[symmetric])
apply(subst (1 2 3 4 5 6 7 8) cp_OclIf[symmetric], simp)
apply(( subst ex_excluding1[symmetric]
| subst al_excluding1[symmetric] ),
metis OclValid_def foundation5,
metis OclValid_def foundation5,
simp add: P_cp[symmetric] bot_fun_def)+
apply(simp add: bot_fun_def)
apply(subst (1 2) invert_including, simp+)
apply(rule conjI, blast)
apply(intro impI conjI)
apply(subst OclExcluding_def)
apply(drule foundation5[simplified OclValid_def], simp)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse[OF diff_in_Set⇩b⇩a⇩s⇩e], fast)
apply(simp add: OclIncluding_def cp_valid[symmetric])
apply((erule conjE)+, frule exclude_defined[simplified OclValid_def], simp)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse[OF ins_in_Set⇩b⇩a⇩s⇩e'''], simp+)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inject[OF ins_in_Set⇩b⇩a⇩s⇩e ins_in_Set⇩b⇩a⇩s⇩e'], fast+)
apply(simp add: OclExcluding_def)
apply(simp add: foundation10[simplified OclValid_def])
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse[OF diff_in_Set⇩b⇩a⇩s⇩e], simp+)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inject[OF ins_in_Set⇩b⇩a⇩s⇩e'' ins_in_Set⇩b⇩a⇩s⇩e'''], simp+)
apply(subgoal_tac "P (λ_. y τ) τ = false τ")
prefer 2
apply(subst P_cp[symmetric], metis OclValid_def foundation22)
apply(rule equalityI)
apply(rule subsetI, simp, metis)
apply(rule subsetI, simp)
apply(drule defined_inject_true)
apply(subgoal_tac "¬ (τ ⊨ δ X) ∨ ¬ (τ ⊨ υ y)")
prefer 2
apply (metis OclIncluding.def_homo OclIncluding_valid_args_valid OclIncluding_valid_args_valid'' OclValid_def foundation18 valid1)
apply(subst cp_OclSelect_body, subst cp_OclSelect, subst OclExcluding_def)
apply(simp add: OclValid_def false_def true_def, rule conjI, blast)
apply(simp add: OclSelect_invalid[simplified invalid_def]
OclSelect_body_strict1[simplified invalid_def]
inv_bot')
done
qed
subsubsection‹Execution Rules on Reject›
lemma OclReject_mtSet_exec[simp,code_unfold]: "OclReject mtSet P = mtSet"
by(simp add: OclReject_def)
lemma OclReject_including_exec[simp,code_unfold]:
assumes P_cp : "cp P"
shows "OclReject (X->including⇩S⇩e⇩t(y)) P = OclSelect_body (not o P) y (OclReject (X->excluding⇩S⇩e⇩t(y)) P)"
apply(simp add: OclReject_def comp_def, rule OclSelect_including_exec)
by (metis assms cp_intro'(5))
subsubsection‹Execution Rules Combining Previous Operators›
text‹OclIncluding›
lemma OclIncluding_idem0 :
assumes "τ ⊨ δ S"
and "τ ⊨ υ i"
shows "τ ⊨ (S->including⇩S⇩e⇩t(i)->including⇩S⇩e⇩t(i) ≜ (S->including⇩S⇩e⇩t(i)))"
by(simp add: OclIncluding_includes OclIncludes_charn1 assms)
theorem OclIncluding_idem[simp,code_unfold]: "((S :: ('𝔄,'a::null)Set)->including⇩S⇩e⇩t(i)->including⇩S⇩e⇩t(i) = (S->including⇩S⇩e⇩t(i)))"
proof -
have A: "⋀ τ. τ ⊨ (i ≜ invalid) ⟹ (S->including⇩S⇩e⇩t(i)->including⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have A':"⋀ τ. τ ⊨ (i ≜ invalid) ⟹ (S->including⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have C: "⋀ τ. τ ⊨ (S ≜ invalid) ⟹ (S->including⇩S⇩e⇩t(i)->including⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have C': "⋀ τ. τ ⊨ (S ≜ invalid) ⟹ (S->including⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have D: "⋀ τ. τ ⊨ (S ≜ null) ⟹ (S->including⇩S⇩e⇩t(i)->including⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have D': "⋀ τ. τ ⊨ (S ≜ null) ⟹ (S->including⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
show ?thesis
apply(rule ext, rename_tac τ)
apply(case_tac "τ ⊨ (υ i)")
apply(case_tac "τ ⊨ (δ S)")
apply(simp only: OclIncluding_idem0[THEN foundation22[THEN iffD1]])
apply(simp add: foundation16', elim disjE)
apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]])
apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]])
apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]])
done
qed
text‹OclExcluding›
lemma OclExcluding_idem0 :
assumes "τ ⊨ δ S"
and "τ ⊨ υ i"
shows "τ ⊨ (S->excluding⇩S⇩e⇩t(i)->excluding⇩S⇩e⇩t(i) ≜ (S->excluding⇩S⇩e⇩t(i)))"
by(simp add: OclExcluding_excludes OclExcludes_charn1 assms)
theorem OclExcluding_idem[simp,code_unfold]: "((S->excluding⇩S⇩e⇩t(i))->excluding⇩S⇩e⇩t(i)) = (S->excluding⇩S⇩e⇩t(i))"
proof -
have A: "⋀ τ. τ ⊨ (i ≜ invalid) ⟹ (S->excluding⇩S⇩e⇩t(i)->excluding⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have A':"⋀ τ. τ ⊨ (i ≜ invalid) ⟹ (S->excluding⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have C: "⋀ τ. τ ⊨ (S ≜ invalid) ⟹ (S->excluding⇩S⇩e⇩t(i)->excluding⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have C': "⋀ τ. τ ⊨ (S ≜ invalid) ⟹ (S->excluding⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have D: "⋀ τ. τ ⊨ (S ≜ null) ⟹ (S->excluding⇩S⇩e⇩t(i)->excluding⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
have D': "⋀ τ. τ ⊨ (S ≜ null) ⟹ (S->excluding⇩S⇩e⇩t(i)) τ = invalid τ"
apply(rule foundation22[THEN iffD1])
by(erule StrongEq_L_subst2_rev, simp,simp)
show ?thesis
apply(rule ext, rename_tac τ)
apply(case_tac "τ ⊨ (υ i)")
apply(case_tac "τ ⊨ (δ S)")
apply(simp only: OclExcluding_idem0[THEN foundation22[THEN iffD1]])
apply(simp add: foundation16', elim disjE)
apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]])
apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]])
apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]])
done
qed
text‹OclIncludes›
lemma OclIncludes_any[simp,code_unfold]:
"X->includes⇩S⇩e⇩t(X->any⇩S⇩e⇩t()) = (if δ X then
if δ (X->size⇩S⇩e⇩t()) then not(X->isEmpty⇩S⇩e⇩t())
else X->includes⇩S⇩e⇩t(null) endif
else invalid endif)"
proof -
have defined_inject_true : "⋀τ P. (δ P) τ ≠ true τ ⟹ (δ P) τ = false τ"
apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def
null_fun_def null_option_def)
by (case_tac " P τ = ⊥ ∨ P τ = null", simp_all add: true_def)
have valid_inject_true : "⋀τ P. (υ P) τ ≠ true τ ⟹ (υ P) τ = false τ"
apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def
null_fun_def null_option_def)
by (case_tac "P τ = ⊥", simp_all add: true_def)
have notempty': "⋀τ X. τ ⊨ δ X ⟹ finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ ⟹ not (X->isEmpty⇩S⇩e⇩t()) τ ≠ true τ ⟹
X τ = Set{} τ"
apply(case_tac "X τ", rename_tac X', simp add: mtSet_def Abs_Set⇩b⇩a⇩s⇩e_inject)
apply(erule disjE, metis (hide_lams, mono_tags) bot_Set⇩b⇩a⇩s⇩e_def bot_option_def foundation16)
apply(erule disjE, metis (hide_lams, no_types) bot_option_def
null_Set⇩b⇩a⇩s⇩e_def null_option_def foundation16[THEN iffD1])
apply(case_tac X', simp, metis (hide_lams, no_types) bot_Set⇩b⇩a⇩s⇩e_def foundation16[THEN iffD1])
apply(rename_tac X'', case_tac X'', simp)
apply (metis (hide_lams, no_types) foundation16[THEN iffD1] null_Set⇩b⇩a⇩s⇩e_def)
apply(simp add: OclIsEmpty_def OclSize_def)
apply(subst (asm) cp_OclNot, subst (asm) cp_OclOr, subst (asm) StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.cp0,
subst (asm) cp_OclAnd, subst (asm) cp_OclNot)
apply(simp only: OclValid_def foundation20[simplified OclValid_def]
cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric])
apply(simp add: Abs_Set⇩b⇩a⇩s⇩e_inverse split: if_split_asm)
by(simp add: true_def OclInt0_def OclNot_def StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r StrongEq_def)
have B: "⋀X τ. ¬ finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ ⟹ (δ (X->size⇩S⇩e⇩t())) τ = false τ"
apply(subst cp_defined)
apply(simp add: OclSize_def)
by (metis bot_fun_def defined_def)
show ?thesis
apply(rule ext, rename_tac τ, simp only: OclIncludes_def OclANY_def)
apply(subst cp_OclIf, subst (2) cp_valid)
apply(case_tac "(δ X) τ = true τ",
simp only: foundation20[simplified OclValid_def] cp_OclIf[symmetric], simp,
subst (1 2) cp_OclAnd, simp add: cp_OclAnd[symmetric])
apply(case_tac "finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉")
apply(frule size_defined'[THEN iffD2, simplified OclValid_def], assumption)
apply(subst (1 2 3 4) cp_OclIf, simp)
apply(subst (1 2 3 4) cp_OclIf[symmetric], simp)
apply(case_tac "(X->notEmpty⇩S⇩e⇩t()) τ = true τ", simp)
apply(frule OclNotEmpty_has_elt[simplified OclValid_def], simp)
apply(simp add: OclNotEmpty_def cp_OclIf[symmetric])
apply(subgoal_tac "(SOME y. y ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉) ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉", simp add: true_def)
apply(metis OclValid_def Set_inv_lemma foundation18' null_option_def true_def)
apply(rule someI_ex, simp)
apply(simp add: OclNotEmpty_def cp_valid[symmetric])
apply(subgoal_tac "¬ (null τ ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉)", simp)
apply(subst OclIsEmpty_def, simp add: OclSize_def)
apply(subst cp_OclNot, subst cp_OclOr, subst StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.cp0, subst cp_OclAnd,
subst cp_OclNot, simp add: OclValid_def foundation20[simplified OclValid_def]
cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric])
apply(frule notempty'[simplified OclValid_def],
(simp add: mtSet_def Abs_Set⇩b⇩a⇩s⇩e_inverse OclInt0_def false_def)+)
apply(drule notempty'[simplified OclValid_def], simp, simp)
apply (metis (hide_lams, no_types) empty_iff mtSet_rep_set)
apply(frule B)
apply(subst (1 2 3 4) cp_OclIf, simp)
apply(subst (1 2 3 4) cp_OclIf[symmetric], simp)
apply(case_tac "(X->notEmpty⇩S⇩e⇩t()) τ = true τ", simp)
apply(frule OclNotEmpty_has_elt[simplified OclValid_def], simp)
apply(simp add: OclNotEmpty_def OclIsEmpty_def)
apply(subgoal_tac "X->size⇩S⇩e⇩t() τ = ⊥")
prefer 2
apply (metis (hide_lams, no_types) OclSize_def)
apply(subst (asm) cp_OclNot, subst (asm) cp_OclOr, subst (asm) StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r.cp0,
subst (asm) cp_OclAnd, subst (asm) cp_OclNot)
apply(simp add: OclValid_def foundation20[simplified OclValid_def]
cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric])
apply(simp add: OclNot_def StrongEq_def StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r valid_def false_def true_def
bot_option_def bot_fun_def invalid_def)
apply (metis bot_fun_def null_fun_def null_is_valid valid_def)
by(drule defined_inject_true,
simp add: false_def true_def OclIf_false[simplified false_def] invalid_def)
qed
text‹OclSize›
lemma [simp,code_unfold]: "δ (Set{} ->size⇩S⇩e⇩t()) = true"
by simp
lemma [simp,code_unfold]: "δ ((X ->including⇩S⇩e⇩t(x)) ->size⇩S⇩e⇩t()) = (δ(X->size⇩S⇩e⇩t()) and υ(x))"
proof -
have defined_inject_true : "⋀τ P. (δ P) τ ≠ true τ ⟹ (δ P) τ = false τ"
apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def
null_fun_def null_option_def)
by (case_tac " P τ = ⊥ ∨ P τ = null", simp_all add: true_def)
have valid_inject_true : "⋀τ P. (υ P) τ ≠ true τ ⟹ (υ P) τ = false τ"
apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def
null_fun_def null_option_def)
by (case_tac "P τ = ⊥", simp_all add: true_def)
have OclIncluding_finite_rep_set : "⋀τ. (δ X and υ x) τ = true τ ⟹
finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->including⇩S⇩e⇩t(x) τ)⌉⌉ = finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
apply(rule OclIncluding_finite_rep_set)
by(metis OclValid_def foundation5)+
have card_including_exec : "⋀τ. (δ (λ_. ⌊⌊int (card ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->including⇩S⇩e⇩t(x) τ)⌉⌉)⌋⌋)) τ =
(δ (λ_. ⌊⌊int (card ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉)⌋⌋)) τ"
by(simp add: defined_def bot_fun_def bot_option_def null_fun_def null_option_def)
show ?thesis
apply(rule ext, rename_tac τ)
apply(case_tac "(δ (X->including⇩S⇩e⇩t(x)->size⇩S⇩e⇩t())) τ = true τ", simp del: OclSize_including_exec)
apply(subst cp_OclAnd, subst cp_defined, simp only: cp_defined[of "X->including⇩S⇩e⇩t(x)->size⇩S⇩e⇩t()"],
simp add: OclSize_def)
apply(case_tac "((δ X and υ x) τ = true τ ∧ finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->including⇩S⇩e⇩t(x) τ)⌉⌉)", simp)
apply(erule conjE,
simp add: OclIncluding_finite_rep_set[simplified OclValid_def] card_including_exec
cp_OclAnd[of "δ X" "υ x"]
cp_OclAnd[of "true", THEN sym])
apply(subgoal_tac "(δ X) τ = true τ ∧ (υ x) τ = true τ", simp)
apply(rule foundation5[of _ "δ X" "υ x", simplified OclValid_def],
simp only: cp_OclAnd[THEN sym])
apply(simp, simp add: defined_def true_def false_def bot_fun_def bot_option_def)
apply(drule defined_inject_true[of "X->including⇩S⇩e⇩t(x)->size⇩S⇩e⇩t()"],
simp del: OclSize_including_exec,
simp only: cp_OclAnd[of "δ (X->size⇩S⇩e⇩t())" "υ x"],
simp add: cp_defined[of "X->including⇩S⇩e⇩t(x)->size⇩S⇩e⇩t()" ] cp_defined[of "X->size⇩S⇩e⇩t()" ]
del: OclSize_including_exec,
simp add: OclSize_def card_including_exec
del: OclSize_including_exec)
apply(case_tac "(δ X and υ x) τ = true τ ∧ finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉",
simp add: OclIncluding_finite_rep_set[simplified OclValid_def] card_including_exec,
simp only: cp_OclAnd[THEN sym],
simp add: defined_def bot_fun_def)
apply(split if_split_asm)
apply(simp add: OclIncluding_finite_rep_set[simplified OclValid_def] card_including_exec)+
apply(simp only: cp_OclAnd[THEN sym], simp, rule impI, erule conjE)
apply(case_tac "(υ x) τ = true τ", simp add: cp_OclAnd[of "δ X" "υ x"])
by(drule valid_inject_true[of "x"], simp add: cp_OclAnd[of _ "υ x"])
qed
lemma [simp,code_unfold]: "δ ((X ->excluding⇩S⇩e⇩t(x)) ->size⇩S⇩e⇩t()) = (δ(X->size⇩S⇩e⇩t()) and υ(x))"
proof -
have defined_inject_true : "⋀τ P. (δ P) τ ≠ true τ ⟹ (δ P) τ = false τ"
apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def
null_fun_def null_option_def)
by (case_tac " P τ = ⊥ ∨ P τ = null", simp_all add: true_def)
have valid_inject_true : "⋀τ P. (υ P) τ ≠ true τ ⟹ (υ P) τ = false τ"
apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def
null_fun_def null_option_def)
by (case_tac "P τ = ⊥", simp_all add: true_def)
have OclExcluding_finite_rep_set : "⋀τ. (δ X and υ x) τ = true τ ⟹
finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->excluding⇩S⇩e⇩t(x) τ)⌉⌉ =
finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
apply(rule OclExcluding_finite_rep_set)
by(metis OclValid_def foundation5)+
have card_excluding_exec : "⋀τ. (δ (λ_. ⌊⌊int (card ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->excluding⇩S⇩e⇩t(x) τ)⌉⌉)⌋⌋)) τ =
(δ (λ_. ⌊⌊int (card ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉)⌋⌋)) τ"
by(simp add: defined_def bot_fun_def bot_option_def null_fun_def null_option_def)
show ?thesis
apply(rule ext, rename_tac τ)
apply(case_tac "(δ (X->excluding⇩S⇩e⇩t(x)->size⇩S⇩e⇩t())) τ = true τ", simp)
apply(subst cp_OclAnd, subst cp_defined, simp only: cp_defined[of "X->excluding⇩S⇩e⇩t(x)->size⇩S⇩e⇩t()"],
simp add: OclSize_def)
apply(case_tac "((δ X and υ x) τ = true τ ∧ finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X->excluding⇩S⇩e⇩t(x) τ)⌉⌉)", simp)
apply(erule conjE,
simp add: OclExcluding_finite_rep_set[simplified OclValid_def] card_excluding_exec
cp_OclAnd[of "δ X" "υ x"]
cp_OclAnd[of "true", THEN sym])
apply(subgoal_tac "(δ X) τ = true τ ∧ (υ x) τ = true τ", simp)
apply(rule foundation5[of _ "δ X" "υ x", simplified OclValid_def],
simp only: cp_OclAnd[THEN sym])
apply(simp, simp add: defined_def true_def false_def bot_fun_def bot_option_def)
apply(drule defined_inject_true[of "X->excluding⇩S⇩e⇩t(x)->size⇩S⇩e⇩t()"],
simp,
simp only: cp_OclAnd[of "δ (X->size⇩S⇩e⇩t())" "υ x"],
simp add: cp_defined[of "X->excluding⇩S⇩e⇩t(x)->size⇩S⇩e⇩t()" ] cp_defined[of "X->size⇩S⇩e⇩t()" ],
simp add: OclSize_def card_excluding_exec)
apply(case_tac "(δ X and υ x) τ = true τ ∧ finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉",
simp add: OclExcluding_finite_rep_set[simplified OclValid_def] card_excluding_exec,
simp only: cp_OclAnd[THEN sym],
simp add: defined_def bot_fun_def)
apply(split if_split_asm)
apply(simp add: OclExcluding_finite_rep_set[simplified OclValid_def] card_excluding_exec)+
apply(simp only: cp_OclAnd[THEN sym], simp, rule impI, erule conjE)
apply(case_tac "(υ x) τ = true τ", simp add: cp_OclAnd[of "δ X" "υ x"])
by(drule valid_inject_true[of "x"], simp add: cp_OclAnd[of _ "υ x"])
qed
lemma [simp]:
assumes X_finite: "⋀τ. finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
shows "δ ((X ->including⇩S⇩e⇩t(x)) ->size⇩S⇩e⇩t()) = (δ(X) and υ(x))"
by(simp add: size_defined[OF X_finite] del: OclSize_including_exec)
text‹OclForall›
lemma OclForall_rep_set_false:
assumes "τ ⊨ δ X"
shows "(OclForall X P τ = false τ) = (∃x ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. P (λτ. x) τ = false τ)"
by(insert assms, simp add: OclForall_def OclValid_def false_def true_def invalid_def
bot_fun_def bot_option_def null_fun_def null_option_def)
lemma OclForall_rep_set_true:
assumes "τ ⊨ δ X"
shows "(τ ⊨ OclForall X P) = (∀x ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. τ ⊨ P (λτ. x))"
proof -
have destruct_ocl : "⋀x τ. x = true τ ∨ x = false τ ∨ x = null τ ∨ x = ⊥ τ"
apply(case_tac x) apply (metis bot_Boolean_def)
apply(rename_tac x', case_tac x') apply (metis null_Boolean_def)
apply(rename_tac x'', case_tac x'') apply (metis (full_types) true_def)
by (metis (full_types) false_def)
have disjE4 : "⋀ P1 P2 P3 P4 R.
(P1 ∨ P2 ∨ P3 ∨ P4) ⟹ (P1 ⟹ R) ⟹ (P2 ⟹ R) ⟹ (P3 ⟹ R) ⟹ (P4 ⟹ R) ⟹ R"
by metis
show ?thesis
apply(simp add: OclForall_def OclValid_def true_def false_def invalid_def
bot_fun_def bot_option_def null_fun_def null_option_def split: if_split_asm)
apply(rule conjI, rule impI) apply (metis drop.simps option.distinct(1) invalid_def)
apply(rule impI, rule conjI, rule impI) apply (metis option.distinct(1))
apply(rule impI, rule conjI, rule impI) apply (metis drop.simps)
apply(intro conjI impI ballI)
proof - fix x show "∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. P (λ_. x) τ ≠ ⌊None⌋ ⟹
∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. ∃y. P (λ_. x) τ = ⌊y⌋ ⟹
∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. P (λ_. x) τ ≠ ⌊⌊False⌋⌋ ⟹
x ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ ⟹ P (λτ. x) τ = ⌊⌊True⌋⌋"
apply(erule_tac x = x in ballE)+
by(rule disjE4[OF destruct_ocl[of "P (λτ. x) τ"]],
(simp add: true_def false_def null_fun_def null_option_def bot_fun_def bot_option_def)+)
qed(simp add: assms[simplified OclValid_def true_def])+
qed
lemma OclForall_includes :
assumes x_def : "τ ⊨ δ x"
and y_def : "τ ⊨ δ y"
shows "(τ ⊨ OclForall x (OclIncludes y)) = (⌈⌈Rep_Set⇩b⇩a⇩s⇩e (x τ)⌉⌉ ⊆ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (y τ)⌉⌉)"
apply(simp add: OclForall_rep_set_true[OF x_def],
simp add: OclIncludes_def OclValid_def y_def[simplified OclValid_def])
apply(insert Set_inv_lemma[OF x_def], simp add: valid_def false_def true_def bot_fun_def)
by(rule iffI, simp add: subsetI, simp add: subsetD)
lemma OclForall_not_includes :
assumes x_def : "τ ⊨ δ x"
and y_def : "τ ⊨ δ y"
shows "(OclForall x (OclIncludes y) τ = false τ) = (¬ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (x τ)⌉⌉ ⊆ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (y τ)⌉⌉)"
apply(simp add: OclForall_rep_set_false[OF x_def],
simp add: OclIncludes_def OclValid_def y_def[simplified OclValid_def])
apply(insert Set_inv_lemma[OF x_def], simp add: valid_def false_def true_def bot_fun_def)
by(rule iffI, metis rev_subsetD, metis subsetI)
lemma OclForall_iterate:
assumes S_finite: "finite ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉"
shows "S->forAll⇩S⇩e⇩t(x | P x) τ = (S->iterate⇩S⇩e⇩t(x; acc = true | acc and P x)) τ"
proof -
have and_comm : "comp_fun_commute (λx acc. acc and P x)"
apply(simp add: comp_fun_commute_def comp_def)
by (metis OclAnd_assoc OclAnd_commute)
have ex_insert : "⋀x F P. (∃x∈insert x F. P x) = (P x ∨ (∃x∈F. P x))"
by (metis insert_iff)
have destruct_ocl : "⋀x τ. x = true τ ∨ x = false τ ∨ x = null τ ∨ x = ⊥ τ"
apply(case_tac x) apply (metis bot_Boolean_def)
apply(rename_tac x', case_tac x') apply (metis null_Boolean_def)
apply(rename_tac x'', case_tac x'') apply (metis (full_types) true_def)
by (metis (full_types) false_def)
have disjE4 : "⋀ P1 P2 P3 P4 R.
(P1 ∨ P2 ∨ P3 ∨ P4) ⟹ (P1 ⟹ R) ⟹ (P2 ⟹ R) ⟹ (P3 ⟹ R) ⟹ (P4 ⟹ R) ⟹ R"
by metis
let ?P_eq = "λx b τ. P (λ_. x) τ = b τ"
let ?P = "λset b τ. ∃x∈set. ?P_eq x b τ"
let ?if = "λf b c. if f b τ then b τ else c"
let ?forall = "λP. ?if P false (?if P invalid (?if P null (true τ)))"
show ?thesis
apply(simp only: OclForall_def OclIterate_def)
apply(case_tac "τ ⊨ δ S", simp only: OclValid_def)
apply(subgoal_tac "let set = ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ in
?forall (?P set) =
Finite_Set.fold (λx acc. acc and P x) true ((λa τ. a) ` set) τ",
simp only: Let_def, simp add: S_finite, simp only: Let_def)
apply(case_tac "⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ = {}", simp)
apply(rule finite_ne_induct[OF S_finite], simp)
apply(simp only: image_insert)
apply(subst comp_fun_commute.fold_insert[OF and_comm], simp)
apply (metis empty_iff image_empty)
apply(simp add: invalid_def)
apply (metis bot_fun_def destruct_ocl null_fun_def)
apply(simp only: image_insert)
apply(subst comp_fun_commute.fold_insert[OF and_comm], simp)
apply (metis (mono_tags) imageE)
apply(subst cp_OclAnd) apply(drule sym, drule sym, simp only:, drule sym, simp only:)
apply(simp only: ex_insert)
apply(subgoal_tac "∃x. x∈F") prefer 2
apply(metis all_not_in_conv)
proof - fix x F show "(δ S) τ = true τ ⟹ ∃x. x ∈ F ⟹
?forall (λb τ. ?P_eq x b τ ∨ ?P F b τ) =
((λ_. ?forall (?P F)) and (λ_. P (λτ. x) τ)) τ"
apply(rule disjE4[OF destruct_ocl[where x1 = "P (λτ. x) τ"]])
apply(simp_all add: true_def false_def invalid_def OclAnd_def
null_fun_def null_option_def bot_fun_def bot_option_def)
by (metis (lifting) option.distinct(1))+
qed(simp add: OclValid_def)+
qed
lemma OclForall_cong:
assumes "⋀x. x ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ ⟹ τ ⊨ P (λτ. x) ⟹ τ ⊨ Q (λτ. x)"
assumes P: "τ ⊨ OclForall X P"
shows "τ ⊨ OclForall X Q"
proof -
have def_X: "τ ⊨ δ X"
by(insert P, simp add: OclForall_def OclValid_def bot_option_def true_def split: if_split_asm)
show ?thesis
apply(insert P)
apply(subst (asm) OclForall_rep_set_true[OF def_X], subst OclForall_rep_set_true[OF def_X])
by (simp add: assms)
qed
lemma OclForall_cong':
assumes "⋀x. x ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ ⟹ τ ⊨ P (λτ. x) ⟹ τ ⊨ Q (λτ. x) ⟹ τ ⊨ R (λτ. x)"
assumes P: "τ ⊨ OclForall X P"
assumes Q: "τ ⊨ OclForall X Q"
shows "τ ⊨ OclForall X R"
proof -
have def_X: "τ ⊨ δ X"
by(insert P, simp add: OclForall_def OclValid_def bot_option_def true_def split: if_split_asm)
show ?thesis
apply(insert P Q)
apply(subst (asm) (1 2) OclForall_rep_set_true[OF def_X], subst OclForall_rep_set_true[OF def_X])
by (simp add: assms)
qed
text‹Strict Equality›
lemma StrictRefEq⇩S⇩e⇩t_defined :
assumes x_def: "τ ⊨ δ x"
assumes y_def: "τ ⊨ δ y"
shows "((x::('𝔄,'α::null)Set) ≐ y) τ =
(x->forAll⇩S⇩e⇩t(z| y->includes⇩S⇩e⇩t(z)) and (y->forAll⇩S⇩e⇩t(z| x->includes⇩S⇩e⇩t(z)))) τ"
proof -
have rep_set_inj : "⋀τ. (δ x) τ = true τ ⟹
(δ y) τ = true τ ⟹
x τ ≠ y τ ⟹
⌈⌈Rep_Set⇩b⇩a⇩s⇩e (y τ)⌉⌉ ≠ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (x τ)⌉⌉"
apply(simp add: defined_def)
apply(split if_split_asm, simp add: false_def true_def)+
apply(simp add: null_fun_def null_Set⇩b⇩a⇩s⇩e_def bot_fun_def bot_Set⇩b⇩a⇩s⇩e_def)
apply(case_tac "x τ", rename_tac x')
apply(case_tac x', simp_all, rename_tac x'')
apply(case_tac x'', simp_all)
apply(case_tac "y τ", rename_tac y')
apply(case_tac y', simp_all, rename_tac y'')
apply(case_tac y'', simp_all)
apply(simp add: Abs_Set⇩b⇩a⇩s⇩e_inverse)
by(blast)
show ?thesis
apply(simp add: StrictRefEq⇩S⇩e⇩t StrongEq_def
foundation20[OF x_def, simplified OclValid_def]
foundation20[OF y_def, simplified OclValid_def])
apply(subgoal_tac "⌊⌊x τ = y τ⌋⌋ = true τ ∨ ⌊⌊x τ = y τ⌋⌋ = false τ")
prefer 2
apply(simp add: false_def true_def)
apply(erule disjE)
apply(simp add: true_def)
apply(subgoal_tac "(τ ⊨ OclForall x (OclIncludes y)) ∧ (τ ⊨ OclForall y (OclIncludes x))")
apply(subst cp_OclAnd, simp add: true_def OclValid_def)
apply(simp add: OclForall_includes[OF x_def y_def]
OclForall_includes[OF y_def x_def])
apply(simp)
apply(subgoal_tac "OclForall x (OclIncludes y) τ = false τ ∨
OclForall y (OclIncludes x) τ = false τ")
apply(subst cp_OclAnd, metis OclAnd_false1 OclAnd_false2 cp_OclAnd)
apply(simp only: OclForall_not_includes[OF x_def y_def, simplified OclValid_def]
OclForall_not_includes[OF y_def x_def, simplified OclValid_def],
simp add: false_def)
by (metis OclValid_def rep_set_inj subset_antisym x_def y_def)
qed
lemma StrictRefEq⇩S⇩e⇩t_exec[simp,code_unfold] :
"((x::('𝔄,'α::null)Set) ≐ y) =
(if δ x then (if δ y
then ((x->forAll⇩S⇩e⇩t(z| y->includes⇩S⇩e⇩t(z)) and (y->forAll⇩S⇩e⇩t(z| x->includes⇩S⇩e⇩t(z)))))
else if υ y
then false
else invalid
endif
endif)
else if υ x
then if υ y then not(δ y) else invalid endif
else invalid
endif
endif)"
proof -
have defined_inject_true : "⋀τ P. (¬ (τ ⊨ δ P)) = ((δ P) τ = false τ)"
by (metis bot_fun_def OclValid_def defined_def foundation16 null_fun_def)
have valid_inject_true : "⋀τ P. (¬ (τ ⊨ υ P)) = ((υ P) τ = false τ)"
by (metis bot_fun_def OclIf_true' OclIncludes_charn0 OclIncludes_charn0' OclValid_def valid_def
foundation6 foundation9)
show ?thesis
apply(rule ext, rename_tac τ)
apply(simp add: OclIf_def
defined_inject_true[simplified OclValid_def]
valid_inject_true[simplified OclValid_def],
subst false_def, subst true_def, simp)
apply(subst (1 2) cp_OclNot, simp, simp add: cp_OclNot[symmetric])
apply(simp add: StrictRefEq⇩S⇩e⇩t_defined[simplified OclValid_def])
by(simp add: StrictRefEq⇩S⇩e⇩t StrongEq_def false_def true_def valid_def defined_def)
qed
lemma StrictRefEq⇩S⇩e⇩t_L_subst1 : "cp P ⟹ τ ⊨ υ x ⟹ τ ⊨ υ y ⟹ τ ⊨ υ P x ⟹ τ ⊨ υ P y ⟹
τ ⊨ (x::('𝔄,'α::null)Set) ≐ y ⟹ τ ⊨ (P x ::('𝔄,'α::null)Set) ≐ P y"
apply(simp only: StrictRefEq⇩S⇩e⇩t OclValid_def)
apply(split if_split_asm)
apply(simp add: StrongEq_L_subst1[simplified OclValid_def])
by (simp add: invalid_def bot_option_def true_def)
lemma OclIncluding_cong' :
shows "τ ⊨ δ s ⟹ τ ⊨ δ t ⟹ τ ⊨ υ x ⟹
τ ⊨ ((s::('𝔄,'a::null)Set) ≐ t) ⟹ τ ⊨ (s->including⇩S⇩e⇩t(x) ≐ (t->including⇩S⇩e⇩t(x)))"
proof -
have cp: "cp (λs. (s->including⇩S⇩e⇩t(x)))"
apply(simp add: cp_def, subst OclIncluding.cp0)
by (rule_tac x = "(λxab ab. ((λ_. xab)->including⇩S⇩e⇩t(λ_. x ab)) ab)" in exI, simp)
show "τ ⊨ δ s ⟹ τ ⊨ δ t ⟹ τ ⊨ υ x ⟹ τ ⊨ (s ≐ t) ⟹ ?thesis"
apply(rule_tac P = "λs. (s->including⇩S⇩e⇩t(x))" in StrictRefEq⇩S⇩e⇩t_L_subst1)
apply(rule cp)
apply(simp add: foundation20) apply(simp add: foundation20)
apply (simp add: foundation10 foundation6)+
done
qed
lemma OclIncluding_cong : "⋀(s::('𝔄,'a::null)Set) t x y τ. τ ⊨ δ t ⟹ τ ⊨ υ y ⟹
τ ⊨ s ≐ t ⟹ x = y ⟹ τ ⊨ s->including⇩S⇩e⇩t(x) ≐ (t->including⇩S⇩e⇩t(y))"
apply(simp only:)
apply(rule OclIncluding_cong', simp_all only:)
by(auto simp: OclValid_def OclIf_def invalid_def bot_option_def OclNot_def split : if_split_asm)
lemma const_StrictRefEq⇩S⇩e⇩t_empty : "const X ⟹ const (X ≐ Set{})"
apply(rule StrictRefEq⇩S⇩e⇩t.const, assumption)
by(simp)
lemma const_StrictRefEq⇩S⇩e⇩t_including :
"const a ⟹ const S ⟹ const X ⟹ const (X ≐ S->including⇩S⇩e⇩t(a))"
apply(rule StrictRefEq⇩S⇩e⇩t.const, assumption)
by(rule const_OclIncluding)
subsection‹Test Statements›
Assert "(τ ⊨ (Set{λ_. ⌊⌊x⌋⌋} ≐ Set{λ_. ⌊⌊x⌋⌋}))"
Assert "(τ ⊨ (Set{λ_. ⌊x⌋} ≐ Set{λ_. ⌊x⌋}))"
instantiation Set⇩b⇩a⇩s⇩e :: (equal)equal
begin
definition "HOL.equal k l ⟷ (k::('a::equal)Set⇩b⇩a⇩s⇩e) = l"
instance by standard (rule equal_Set⇩b⇩a⇩s⇩e_def)
end
lemma equal_Set⇩b⇩a⇩s⇩e_code [code]:
"HOL.equal k (l::('a::{equal,null})Set⇩b⇩a⇩s⇩e) ⟷ Rep_Set⇩b⇩a⇩s⇩e k = Rep_Set⇩b⇩a⇩s⇩e l"
by (auto simp add: equal Set⇩b⇩a⇩s⇩e.Rep_Set⇩b⇩a⇩s⇩e_inject)
Assert "τ ⊨ (Set{} ≐ Set{})"
Assert "τ ⊨ (Set{𝟭,𝟮} ≜ Set{}->including⇩S⇩e⇩t(𝟮)->including⇩S⇩e⇩t(𝟭))"
Assert "τ ⊨ (Set{𝟭,invalid,𝟮} ≜ invalid)"
Assert "τ ⊨ (Set{𝟭,𝟮}->including⇩S⇩e⇩t(null) ≜ Set{null,𝟭,𝟮})"
Assert "τ ⊨ (Set{𝟭,𝟮}->including⇩S⇩e⇩t(null) ≜ Set{𝟭,𝟮,null})"
end
Theory UML_Sequence
theory UML_Sequence
imports "../basic_types/UML_Boolean"
"../basic_types/UML_Integer"
begin
no_notation None ("⊥")
section‹Collection Type Sequence: Operations›
subsection‹Basic Properties of the Sequence Type›
text‹Every element in a defined sequence is valid.›
lemma Sequence_inv_lemma: "τ ⊨ (δ X) ⟹ ∀x∈set ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (X τ)⌉⌉. x ≠ bot"
apply(insert Rep_Sequence⇩b⇩a⇩s⇩e [of "X τ"], simp)
apply(auto simp: OclValid_def defined_def false_def true_def cp_def
bot_fun_def bot_Sequence⇩b⇩a⇩s⇩e_def null_Sequence⇩b⇩a⇩s⇩e_def null_fun_def
split:if_split_asm)
apply(erule contrapos_pp [of "Rep_Sequence⇩b⇩a⇩s⇩e (X τ) = bot"])
apply(subst Abs_Sequence⇩b⇩a⇩s⇩e_inject[symmetric], rule Rep_Sequence⇩b⇩a⇩s⇩e, simp)
apply(simp add: Rep_Sequence⇩b⇩a⇩s⇩e_inverse bot_Sequence⇩b⇩a⇩s⇩e_def bot_option_def)
apply(erule contrapos_pp [of "Rep_Sequence⇩b⇩a⇩s⇩e (X τ) = null"])
apply(subst Abs_Sequence⇩b⇩a⇩s⇩e_inject[symmetric], rule Rep_Sequence⇩b⇩a⇩s⇩e, simp)
apply(simp add: Rep_Sequence⇩b⇩a⇩s⇩e_inverse null_option_def)
by (simp add: bot_option_def)
subsection‹Definition: Strict Equality \label{sec:seq-strict-equality}›
text‹After the part of foundational operations on sets, we detail here equality on sets.
Strong equality is inherited from the OCL core, but we have to consider
the case of the strict equality. We decide to overload strict equality in the
same way we do for other value's in OCL:›
overloading
StrictRefEq ≡ "StrictRefEq :: [('𝔄,'α::null)Sequence,('𝔄,'α::null)Sequence] ⇒ ('𝔄)Boolean"
begin
definition StrictRefEq⇩S⇩e⇩q :
"((x::('𝔄,'α::null)Sequence) ≐ y) ≡ (λ τ. if (υ x) τ = true τ ∧ (υ y) τ = true τ
then (x ≜ y)τ
else invalid τ)"
end
text_raw‹\isatagafp›
text‹One might object here that for the case of objects, this is an empty definition.
The answer is no, we will restrain later on states and objects such that any object
has its oid stored inside the object (so the ref, under which an object can be referenced
in the store will represented in the object itself). For such well-formed stores that satisfy
this invariant (the WFF-invariant), the referential equality and the
strong equality---and therefore the strict equality on sequences in the sense above---coincides.›
text_raw‹\endisatagafp›
text‹Property proof in terms of @{term "profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v"}›
interpretation StrictRefEq⇩S⇩e⇩q : profile_bin⇩S⇩t⇩r⇩o⇩n⇩g⇩E⇩q_⇩v_⇩v "λ x y. (x::('𝔄,'α::null)Sequence) ≐ y"
by unfold_locales (auto simp: StrictRefEq⇩S⇩e⇩q)
subsection‹Constants: mtSequence›
definition mtSequence ::"('𝔄,'α::null) Sequence" ("Sequence{}")
where "Sequence{} ≡ (λ τ. Abs_Sequence⇩b⇩a⇩s⇩e ⌊⌊[]::'α list⌋⌋ )"
lemma mtSequence_defined[simp,code_unfold]:"δ(Sequence{}) = true"
apply(rule ext, auto simp: mtSequence_def defined_def null_Sequence⇩b⇩a⇩s⇩e_def
bot_Sequence⇩b⇩a⇩s⇩e_def bot_fun_def null_fun_def)
by(simp_all add: Abs_Sequence⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
lemma mtSequence_valid[simp,code_unfold]:"υ(Sequence{}) = true"
apply(rule ext,auto simp: mtSequence_def valid_def null_Sequence⇩b⇩a⇩s⇩e_def
bot_Sequence⇩b⇩a⇩s⇩e_def bot_fun_def null_fun_def)
by(simp_all add: Abs_Sequence⇩b⇩a⇩s⇩e_inject bot_option_def null_option_def)
lemma mtSequence_rep_set: "⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (Sequence{} τ)⌉⌉ = []"
apply(simp add: mtSequence_def, subst Abs_Sequence⇩b⇩a⇩s⇩e_inverse)
by(simp add: bot_option_def)+
text_raw‹\isatagafp›
lemma [simp,code_unfold]: "const Sequence{}"
by(simp add: const_def mtSequence_def)
text‹Note that the collection types in OCL allow for null to be included;
however, there is the null-collection into which inclusion yields invalid.›
text_raw‹\endisatagafp›
subsection‹Definition: Prepend›
definition OclPrepend :: "[('𝔄,'α::null) Sequence,('𝔄,'α) val] ⇒ ('𝔄,'α) Sequence"
where "OclPrepend x y = (λ τ. if (δ x) τ = true τ ∧ (υ y) τ = true τ
then Abs_Sequence⇩b⇩a⇩s⇩e ⌊⌊ (y τ)#⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (x τ)⌉⌉ ⌋⌋
else invalid τ )"
notation OclPrepend ("_->prepend⇩S⇩e⇩q'(_')")
interpretation OclPrepend:profile_bin⇩d_⇩v OclPrepend "λx y. Abs_Sequence⇩b⇩a⇩s⇩e⌊⌊y#⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉⌋⌋"
proof -
have A : "⋀x y. x ≠ bot ⟹ x ≠ null ⟹ y ≠ bot ⟹
⌊⌊y#⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈set ⌈⌈X⌉⌉. x ≠ bot)}"
by(auto intro!:Sequence_inv_lemma[simplified OclValid_def
defined_def false_def true_def null_fun_def bot_fun_def])
show "profile_bin⇩d_⇩v OclPrepend (λx y. Abs_Sequence⇩b⇩a⇩s⇩e ⌊⌊y#⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉⌋⌋)"
apply unfold_locales
apply(auto simp:OclPrepend_def bot_option_def null_option_def null_Sequence⇩b⇩a⇩s⇩e_def
bot_Sequence⇩b⇩a⇩s⇩e_def)
apply(erule_tac Q="Abs_Sequence⇩b⇩a⇩s⇩e ⌊⌊y#⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉⌋⌋ = Abs_Sequence⇩b⇩a⇩s⇩e None"
in contrapos_pp)
apply(subst Abs_Sequence⇩b⇩a⇩s⇩e_inject [OF A])
apply(simp_all add: null_Sequence⇩b⇩a⇩s⇩e_def bot_Sequence⇩b⇩a⇩s⇩e_def bot_option_def)
apply(erule_tac Q="Abs_Sequence⇩b⇩a⇩s⇩e⌊⌊y#⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉⌋⌋ = Abs_Sequence⇩b⇩a⇩s⇩e ⌊None⌋"
in contrapos_pp)
apply(subst Abs_Sequence⇩b⇩a⇩s⇩e_inject[OF A])
apply(simp_all add: null_Sequence⇩b⇩a⇩s⇩e_def bot_Sequence⇩b⇩a⇩s⇩e_def
bot_option_def null_option_def)
done
qed
syntax
"_OclFinsequence" :: "args => ('𝔄,'a::null) Sequence" ("Sequence{(_)}")
translations
"Sequence{x, xs}" == "CONST OclPrepend (Sequence{xs}) x"
"Sequence{x}" == "CONST OclPrepend (Sequence{}) x "
subsection‹Definition: Including›
definition OclIncluding :: "[('𝔄,'α::null) Sequence,('𝔄,'α) val] ⇒ ('𝔄,'α) Sequence"
where "OclIncluding x y = (λ τ. if (δ x) τ = true τ ∧ (υ y) τ = true τ
then Abs_Sequence⇩b⇩a⇩s⇩e ⌊⌊ ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (x τ)⌉⌉ @ [y τ] ⌋⌋
else invalid τ )"
notation OclIncluding ("_->including⇩S⇩e⇩q'(_')")
interpretation OclIncluding :
profile_bin⇩d_⇩v OclIncluding "λx y. Abs_Sequence⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉ @ [y]⌋⌋"
proof -
have A : "⋀x y. x ≠ bot ⟹ x ≠ null ⟹ y ≠ bot ⟹
⌊⌊⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉ @ [y]⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈set ⌈⌈X⌉⌉. x ≠ bot)}"
by(auto intro!:Sequence_inv_lemma[simplified OclValid_def
defined_def false_def true_def null_fun_def bot_fun_def])
show "profile_bin⇩d_⇩v OclIncluding (λx y. Abs_Sequence⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉ @ [y]⌋⌋)"
apply unfold_locales
apply(auto simp:OclIncluding_def bot_option_def null_option_def null_Sequence⇩b⇩a⇩s⇩e_def
bot_Sequence⇩b⇩a⇩s⇩e_def)
apply(erule_tac Q="Abs_Sequence⇩b⇩a⇩s⇩e ⌊⌊⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉ @ [y]⌋⌋ = Abs_Sequence⇩b⇩a⇩s⇩e None"
in contrapos_pp)
apply(subst Abs_Sequence⇩b⇩a⇩s⇩e_inject [OF A])
apply(simp_all add: null_Sequence⇩b⇩a⇩s⇩e_def bot_Sequence⇩b⇩a⇩s⇩e_def bot_option_def)
apply(erule_tac Q="Abs_Sequence⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉ @ [y]⌋⌋ = Abs_Sequence⇩b⇩a⇩s⇩e ⌊None⌋"
in contrapos_pp)
apply(subst Abs_Sequence⇩b⇩a⇩s⇩e_inject[OF A])
apply(simp_all add: null_Sequence⇩b⇩a⇩s⇩e_def bot_Sequence⇩b⇩a⇩s⇩e_def bot_option_def null_option_def)
done
qed
lemma [simp,code_unfold] : "(Sequence{}->including⇩S⇩e⇩q(a)) = (Sequence{}->prepend⇩S⇩e⇩q(a))"
apply(simp add: OclIncluding_def OclPrepend_def mtSequence_def)
apply(subst (1 2) Abs_Sequence⇩b⇩a⇩s⇩e_inverse, simp)
by(metis drop.simps append_Nil)
lemma [simp,code_unfold] : "((S->prepend⇩S⇩e⇩q(a))->including⇩S⇩e⇩q(b)) = ((S->including⇩S⇩e⇩q(b))->prepend⇩S⇩e⇩q(a))"
proof -
have A: "⋀S b τ. S ≠ ⊥ ⟹ S ≠ null ⟹ b ≠ ⊥ ⟹
⌊⌊⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e S⌉⌉ @ [b]⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈set ⌈⌈X⌉⌉. x ≠ ⊥)}"
by(auto intro!:Sequence_inv_lemma[simplified OclValid_def
defined_def false_def true_def null_fun_def bot_fun_def])
have B: "⋀S a τ. S ≠ ⊥ ⟹ S ≠ null ⟹ a ≠ ⊥ ⟹
⌊⌊a # ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e S⌉⌉⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈set ⌈⌈X⌉⌉. x ≠ ⊥)}"
by(auto intro!:Sequence_inv_lemma[simplified OclValid_def
defined_def false_def true_def null_fun_def bot_fun_def])
show ?thesis
apply(simp add: OclIncluding_def OclPrepend_def mtSequence_def, rule ext)
apply(subst (2 5) cp_defined, simp split:)
apply(intro conjI impI)
apply(subst Abs_Sequence⇩b⇩a⇩s⇩e_inverse[OF B],
(simp add: foundation16[simplified OclValid_def] foundation18'[simplified OclValid_def])+)
apply(subst Abs_Sequence⇩b⇩a⇩s⇩e_inverse[OF A],
(simp add: foundation16[simplified OclValid_def] foundation18'[simplified OclValid_def])+)
apply(simp add: OclIncluding.def_body)
apply (metis OclValid_def foundation16 invalid_def)
apply (metis (no_types) OclPrepend.def_body' OclValid_def foundation16)
by (metis OclValid_def foundation16 invalid_def)+
qed
subsection‹Definition: Excluding›
definition OclExcluding :: "[('𝔄,'α::null) Sequence,('𝔄,'α) val] ⇒ ('𝔄,'α) Sequence"
where "OclExcluding x y = (λ τ. if (δ x) τ = true τ ∧ (υ y) τ = true τ
then Abs_Sequence⇩b⇩a⇩s⇩e ⌊⌊ filter (λx. x = y τ)
⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (x τ)⌉⌉⌋⌋
else invalid τ )"
notation OclExcluding ("_->excluding⇩S⇩e⇩q'(_')")
interpretation OclExcluding:profile_bin⇩d_⇩v OclExcluding
"λx y. Abs_Sequence⇩b⇩a⇩s⇩e ⌊⌊ filter (λx. x = y) ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (x)⌉⌉⌋⌋"
proof -
show "profile_bin⇩d_⇩v OclExcluding (λx y. Abs_Sequence⇩b⇩a⇩s⇩e ⌊⌊[x←⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉ . x = y]⌋⌋)"
apply unfold_locales
apply(auto simp:OclExcluding_def bot_option_def null_option_def
null_Sequence⇩b⇩a⇩s⇩e_def bot_Sequence⇩b⇩a⇩s⇩e_def)
apply(subst (asm) Abs_Sequence⇩b⇩a⇩s⇩e_inject,
simp_all add: null_Sequence⇩b⇩a⇩s⇩e_def bot_Sequence⇩b⇩a⇩s⇩e_def bot_option_def null_option_def)+
done
qed
subsection‹Definition: Append›
text‹Identical to OclIncluding.›
definition OclAppend :: "[('𝔄,'α::null) Sequence,('𝔄,'α) val] ⇒ ('𝔄,'α) Sequence"
where "OclAppend = OclIncluding"
notation OclAppend ("_->append⇩S⇩e⇩q'(_')")
interpretation OclAppend :
profile_bin⇩d_⇩v OclAppend "λx y. Abs_Sequence⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉ @ [y]⌋⌋"
apply unfold_locales
by(auto simp: OclAppend_def bin_def bin'_def
OclIncluding.def_scheme OclIncluding.def_body)
subsection‹Definition: Union›
definition OclUnion :: "[('𝔄,'α::null) Sequence,('𝔄,'α) Sequence] ⇒ ('𝔄,'α) Sequence"
where "OclUnion x y = (λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then Abs_Sequence⇩b⇩a⇩s⇩e ⌊⌊ ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (x τ)⌉⌉ @
⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (y τ)⌉⌉⌋⌋
else invalid τ )"
notation OclUnion ("_->union⇩S⇩e⇩q'(_')")
interpretation OclUnion :
profile_bin⇩d_⇩d OclUnion "λx y. Abs_Sequence⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉ @ ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e y⌉⌉⌋⌋"
proof -
have A : "⋀x y. x ≠ ⊥ ⟹ x ≠ null ⟹ ∀x∈set ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉. x ≠ ⊥ "
apply(rule Sequence_inv_lemma[of τ])
by(simp add: defined_def OclValid_def bot_fun_def null_fun_def false_def true_def)
show "profile_bin⇩d_⇩d OclUnion (λx y. Abs_Sequence⇩b⇩a⇩s⇩e⌊⌊⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e x⌉⌉@⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e y⌉⌉⌋⌋)"
apply unfold_locales
apply(auto simp:OclUnion_def bot_option_def null_option_def
null_Sequence⇩b⇩a⇩s⇩e_def bot_Sequence⇩b⇩a⇩s⇩e_def)
by(subst (asm) Abs_Sequence⇩b⇩a⇩s⇩e_inject,
simp_all add: bot_option_def null_option_def Set.ball_Un A null_Sequence⇩b⇩a⇩s⇩e_def bot_Sequence⇩b⇩a⇩s⇩e_def)+
qed
subsection‹Definition: At›
definition OclAt :: "[('𝔄,'α::null) Sequence,('𝔄) Integer] ⇒ ('𝔄,'α) val"
where "OclAt x y = (λ τ. if (δ x) τ = true τ ∧ (δ y) τ = true τ
then if 1 ≤ ⌈⌈y τ⌉⌉ ∧ ⌈⌈y τ⌉⌉ ≤ length⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (x τ)⌉⌉
then ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (x τ)⌉⌉ ! (nat ⌈⌈y τ⌉⌉ - 1)
else invalid τ
else invalid τ )"
notation OclAt ("_->at⇩S⇩e⇩q'(_')")
subsection‹Definition: First›
definition OclFirst :: "[('𝔄,'α::null) Sequence] ⇒ ('𝔄,'α) val"
where "OclFirst x = (λ τ. if (δ x) τ = true τ then
case ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (x τ)⌉⌉ of [] ⇒ invalid τ
| x # _ ⇒ x
else invalid τ )"
notation OclFirst ("_->first⇩S⇩e⇩q'(_')")
subsection‹Definition: Last›
definition OclLast :: "[('𝔄,'α::null) Sequence] ⇒ ('𝔄,'α) val"
where "OclLast x = (λ τ. if (δ x) τ = true τ then
if ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (x τ)⌉⌉ = [] then
invalid τ
else
last ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (x τ)⌉⌉
else invalid τ )"
notation OclLast ("_->last⇩S⇩e⇩q'(_')")
subsection‹Definition: Iterate›
definition OclIterate :: "[('𝔄,'α::null) Sequence,('𝔄,'β::null)val,
('𝔄,'α)val⇒('𝔄,'β)val⇒('𝔄,'β)val] ⇒ ('𝔄,'β)val"
where "OclIterate S A F = (λ τ. if (δ S) τ = true τ ∧ (υ A) τ = true τ
then (foldr (F) (map (λa τ. a) ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (S τ)⌉⌉))(A)τ
else ⊥)"
syntax
"_OclIterateSeq" :: "[('𝔄,'α::null) Sequence, idt, idt, 'α, 'β] => ('𝔄,'γ)val"
("_ ->iterate⇩S⇩e⇩q'(_;_=_ | _')" )
translations
"X->iterate⇩S⇩e⇩q(a; x = A | P)" == "CONST OclIterate X A (%a. (% x. P))"
subsection‹Definition: Forall›
definition OclForall :: "[('𝔄,'α::null) Sequence,('𝔄,'α)val⇒('𝔄)Boolean] ⇒ '𝔄 Boolean"
where "OclForall S P = (S->iterate⇩S⇩e⇩q(b; x = true | x and (P b)))"
syntax
"_OclForallSeq" :: "[('𝔄,'α::null) Sequence,id,('𝔄)Boolean] ⇒ '𝔄 Boolean" ("(_)->forAll⇩S⇩e⇩q'(_|_')")
translations
"X->forAll⇩S⇩e⇩q(x | P)" == "CONST UML_Sequence.OclForall X (%x. P)"
subsection‹Definition: Exists›
definition OclExists :: "[('𝔄,'α::null) Sequence,('𝔄,'α)val⇒('𝔄)Boolean] ⇒ '𝔄 Boolean"
where "OclExists S P = (S->iterate⇩S⇩e⇩q(b; x = false | x or (P b)))"
syntax
"_OclExistSeq" :: "[('𝔄,'α::null) Sequence,id,('𝔄)Boolean] ⇒ '𝔄 Boolean" ("(_)->exists⇩S⇩e⇩q'(_|_')")
translations
"X->exists⇩S⇩e⇩q(x | P)" == "CONST OclExists X (%x. P)"
subsection‹Definition: Collect›
definition OclCollect :: "[('𝔄,'α::null)Sequence,('𝔄,'α)val⇒('𝔄,'β)val]⇒('𝔄,'β::null)Sequence"
where "OclCollect S P = (S->iterate⇩S⇩e⇩q(b; x = Sequence{} | x->prepend⇩S⇩e⇩q(P b)))"
syntax
"_OclCollectSeq" :: "[('𝔄,'α::null) Sequence,id,('𝔄)Boolean] ⇒ '𝔄 Boolean" ("(_)->collect⇩S⇩e⇩q'(_|_')")
translations
"X->collect⇩S⇩e⇩q(x | P)" == "CONST OclCollect X (%x. P)"
subsection‹Definition: Select›
definition OclSelect :: "[('𝔄,'α::null)Sequence,('𝔄,'α)val⇒('𝔄)Boolean]⇒('𝔄,'α::null)Sequence"
where "OclSelect S P =
(S->iterate⇩S⇩e⇩q(b; x = Sequence{} | if P b then x->prepend⇩S⇩e⇩q(b) else x endif))"
syntax
"_OclSelectSeq" :: "[('𝔄,'α::null) Sequence,id,('𝔄)Boolean] ⇒ '𝔄 Boolean" ("(_)->select⇩S⇩e⇩q'(_|_')")
translations
"X->select⇩S⇩e⇩q(x | P)" == "CONST UML_Sequence.OclSelect X (%x. P)"
subsection‹Definition: Size›
definition OclSize :: "[('𝔄,'α::null)Sequence]⇒('𝔄)Integer" ("(_)->size⇩S⇩e⇩q'(')")
where "OclSize S = (S->iterate⇩S⇩e⇩q(b; x = 𝟬 | x +⇩i⇩n⇩t 𝟭 ))"
subsection‹Definition: IsEmpty›
definition OclIsEmpty :: "('𝔄,'α::null) Sequence ⇒ '𝔄 Boolean"
where "OclIsEmpty x = ((υ x and not (δ x)) or ((OclSize x) ≐ 𝟬))"
notation OclIsEmpty ("_->isEmpty⇩S⇩e⇩q'(')" )
subsection‹Definition: NotEmpty›
definition OclNotEmpty :: "('𝔄,'α::null) Sequence ⇒ '𝔄 Boolean"
where "OclNotEmpty x = not(OclIsEmpty x)"
notation OclNotEmpty ("_->notEmpty⇩S⇩e⇩q'(')" )
subsection‹Definition: Any›
definition "OclANY x = (λ τ.
if x τ = invalid τ then
⊥
else
case drop (drop (Rep_Sequence⇩b⇩a⇩s⇩e (x τ))) of [] ⇒ ⊥
| l ⇒ hd l)"
notation OclANY ("_->any⇩S⇩e⇩q'(')")
subsection‹Definition (future operators)›
consts
OclCount :: "[('𝔄,'α::null) Sequence,('𝔄,'α) Sequence] ⇒ '𝔄 Integer"
OclSum :: " ('𝔄,'α::null) Sequence ⇒ '𝔄 Integer"
notation OclCount ("_->count⇩S⇩e⇩q'(_')" )
notation OclSum ("_->sum⇩S⇩e⇩q'(')" )
subsection‹Logical Properties›
subsection‹Execution Laws with Invalid or Null as Argument›
text‹OclIterate›
lemma OclIterate_invalid[simp,code_unfold]:"invalid->iterate⇩S⇩e⇩q(a; x = A | P a x) = invalid"
by(simp add: OclIterate_def false_def true_def, simp add: invalid_def)
lemma OclIterate_null[simp,code_unfold]:"null->iterate⇩S⇩e⇩q(a; x = A | P a x) = invalid"
by(simp add: OclIterate_def false_def true_def, simp add: invalid_def)
lemma OclIterate_invalid_args[simp,code_unfold]:"S->iterate⇩S⇩e⇩q(a; x = invalid | P a x) = invalid"
by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def)
text_raw‹\isatagafp›
subsubsection‹Context Passing›
lemma cp_OclIncluding:
"(X->including⇩S⇩e⇩q(x)) τ = ((λ _. X τ)->including⇩S⇩e⇩q(λ _. x τ)) τ"
by(auto simp: OclIncluding_def StrongEq_def invalid_def
cp_defined[symmetric] cp_valid[symmetric])
lemma cp_OclIterate:
"(X->iterate⇩S⇩e⇩q(a; x = A | P a x)) τ =
((λ _. X τ)->iterate⇩S⇩e⇩q(a; x = A | P a x)) τ"
by(simp add: OclIterate_def cp_defined[symmetric])
lemmas cp_intro''⇩S⇩e⇩q[intro!,simp,code_unfold] =
cp_OclIncluding [THEN allI[THEN allI[THEN allI[THEN cpI2]], of "OclIncluding"]]
subsubsection‹Const›
text_raw‹\endisatagafp›
subsection‹General Algebraic Execution Rules›
subsubsection‹Execution Rules on Iterate›
lemma OclIterate_empty[simp,code_unfold]:"Sequence{}->iterate⇩S⇩e⇩q(a; x = A | P a x) = A"
apply(simp add: OclIterate_def foundation22[symmetric] foundation13,
rule ext, rename_tac "τ")
apply(case_tac "τ ⊨ υ A", simp_all add: foundation18')
apply(simp add: mtSequence_def)
apply(subst Abs_Sequence⇩b⇩a⇩s⇩e_inverse) by auto
text‹In particular, this does hold for A = null.›
lemma OclIterate_including[simp,code_unfold]:
assumes strict1 : "⋀X. P invalid X = invalid"
and P_valid_arg: "⋀ τ. (υ A) τ = (υ (P a A)) τ"
and P_cp : "⋀ x y τ. P x y τ = P (λ _. x τ) y τ"
and P_cp' : "⋀ x y τ. P x y τ = P x (λ _. y τ) τ"
shows "(S->including⇩S⇩e⇩q(a))->iterate⇩S⇩e⇩q(b; x = A | P b x) = S->iterate⇩S⇩e⇩q(b; x = P a A| P b x)"
apply(rule ext)
proof -
have A: "⋀S b τ. S ≠ ⊥ ⟹ S ≠ null ⟹ b ≠ ⊥ ⟹
⌊⌊⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e S⌉⌉ @ [b]⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈set ⌈⌈X⌉⌉. x ≠ ⊥)}"
by(auto intro!:Sequence_inv_lemma[simplified OclValid_def
defined_def false_def true_def null_fun_def bot_fun_def])
have P: "⋀l A A' τ. A τ = A' τ ⟹ foldr P l A τ = foldr P l A' τ"
apply(rule list.induct, simp, simp)
by(subst (1 2) P_cp', simp)
fix τ
show "OclIterate (S->including⇩S⇩e⇩q(a)) A P τ = OclIterate S (P a A) P τ"
apply(subst cp_OclIterate, subst OclIncluding_def, simp split:)
apply(intro conjI impI)
apply(simp add: OclIterate_def)
apply(intro conjI impI)
apply(subst Abs_Sequence⇩b⇩a⇩s⇩e_inverse[OF A],
(simp add: foundation16[simplified OclValid_def] foundation18'[simplified OclValid_def])+)
apply(rule P, metis P_cp)
apply (metis P_valid_arg)
apply(simp add: P_valid_arg[symmetric])
apply (metis (lifting, no_types) OclIncluding.def_body' OclValid_def foundation16)
apply(simp add: OclIterate_def defined_def invalid_def bot_option_def bot_fun_def false_def true_def)
apply(intro impI, simp add: false_def true_def P_valid_arg)
by (metis P_cp P_valid_arg UML_Types.bot_fun_def cp_valid invalid_def strict1 true_def valid1 valid_def)
qed
lemma OclIterate_prepend[simp,code_unfold]:
assumes strict1 : "⋀X. P invalid X = invalid"
and strict2 : "⋀X. P X invalid = invalid"
and P_cp : "⋀ x y τ. P x y τ = P (λ _. x τ) y τ"
and P_cp' : "⋀ x y τ. P x y τ = P x (λ _. y τ) τ"
shows "(S->prepend⇩S⇩e⇩q(a))->iterate⇩S⇩e⇩q(b; x = A | P b x) = P a (S->iterate⇩S⇩e⇩q(b; x = A| P b x))"
apply(rule ext)
proof -
have B: "⋀S a τ. S ≠ ⊥ ⟹ S ≠ null ⟹ a ≠ ⊥ ⟹
⌊⌊a # ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e S⌉⌉⌋⌋ ∈ {X. X = bot ∨ X = null ∨ (∀x∈set ⌈⌈X⌉⌉. x ≠ ⊥)}"
by(auto intro!:Sequence_inv_lemma[simplified OclValid_def
defined_def false_def true_def null_fun_def bot_fun_def])
fix τ
show "OclIterate (S->prepend⇩S⇩e⇩q(a)) A P τ = P a (OclIterate S A P) τ"
apply(subst cp_OclIterate, subst OclPrepend_def, simp split:)
apply(intro conjI impI)
apply(subst P_cp')
apply(simp add: OclIterate_def)
apply(intro conjI impI)
apply(subst Abs_Sequence⇩b⇩a⇩s⇩e_inverse[OF B],
(simp add: foundation16[simplified OclValid_def] foundation18'[simplified OclValid_def])+)
apply(simp add: P_cp'[symmetric])
apply(subst P_cp, simp add: P_cp[symmetric])
apply (metis (no_types) OclPrepend.def_body' OclValid_def foundation16)
apply (metis P_cp' invalid_def strict2 valid_def)
apply(subst P_cp',
simp add: OclIterate_def defined_def invalid_def bot_option_def bot_fun_def false_def true_def,
intro conjI impI)
apply (metis P_cp' invalid_def strict2 valid_def)
apply (metis P_cp' invalid_def strict2 valid_def)
apply (metis (no_types) P_cp invalid_def strict1 true_def valid1 valid_def)
apply (metis P_cp' invalid_def strict2 valid_def)
done
qed
subsection‹Test Statements›
instantiation Sequence⇩b⇩a⇩s⇩e :: (equal)equal
begin
definition "HOL.equal k l ⟷ (k::('a::equal)Sequence⇩b⇩a⇩s⇩e) = l"
instance by standard (rule equal_Sequence⇩b⇩a⇩s⇩e_def)
end
lemma equal_Sequence⇩b⇩a⇩s⇩e_code [code]:
"HOL.equal k (l::('a::{equal,null})Sequence⇩b⇩a⇩s⇩e) ⟷ Rep_Sequence⇩b⇩a⇩s⇩e k = Rep_Sequence⇩b⇩a⇩s⇩e l"
by (auto simp add: equal Sequence⇩b⇩a⇩s⇩e.Rep_Sequence⇩b⇩a⇩s⇩e_inject)
Assert "τ ⊨ (Sequence{} ≐ Sequence{})"
Assert "τ ⊨ (Sequence{𝟭,𝟮} ≜ Sequence{}->prepend⇩S⇩e⇩q(𝟮)->prepend⇩S⇩e⇩q(𝟭))"
Assert "τ ⊨ (Sequence{𝟭,invalid,𝟮} ≜ invalid)"
Assert "τ ⊨ (Sequence{𝟭,𝟮}->prepend⇩S⇩e⇩q(null) ≜ Sequence{null,𝟭,𝟮})"
Assert "τ ⊨ (Sequence{𝟭,𝟮}->including⇩S⇩e⇩q(null) ≜ Sequence{𝟭,𝟮,null})"
end
Theory UML_Library
theory UML_Library
imports
"basic_types/UML_Boolean"
"basic_types/UML_Void"
"basic_types/UML_Integer"
"basic_types/UML_Real"
"basic_types/UML_String"
"collection_types/UML_Pair"
"collection_types/UML_Bag"
"collection_types/UML_Set"
"collection_types/UML_Sequence"
begin
section‹Miscellaneous Stuff›
subsection‹Definition: asBoolean›
definition OclAsBoolean⇩I⇩n⇩t :: "('𝔄) Integer ⇒ ('𝔄) Boolean" ("(_)->oclAsType⇩I⇩n⇩t'(Boolean')")
where "OclAsBoolean⇩I⇩n⇩t X = (λτ. if (δ X) τ = true τ
then ⌊⌊⌈⌈X τ⌉⌉ ≠ 0⌋⌋
else invalid τ)"
interpretation OclAsBoolean⇩I⇩n⇩t : profile_mono⇩d OclAsBoolean⇩I⇩n⇩t "λx. ⌊⌊⌈⌈x⌉⌉ ≠ 0⌋⌋"
by unfold_locales (auto simp: OclAsBoolean⇩I⇩n⇩t_def bot_option_def)
definition OclAsBoolean⇩R⇩e⇩a⇩l :: "('𝔄) Real ⇒ ('𝔄) Boolean" ("(_)->oclAsType⇩R⇩e⇩a⇩l'(Boolean')")
where "OclAsBoolean⇩R⇩e⇩a⇩l X = (λτ. if (δ X) τ = true τ
then ⌊⌊⌈⌈X τ⌉⌉ ≠ 0⌋⌋
else invalid τ)"
interpretation OclAsBoolean⇩R⇩e⇩a⇩l : profile_mono⇩d OclAsBoolean⇩R⇩e⇩a⇩l "λx. ⌊⌊⌈⌈x⌉⌉ ≠ 0⌋⌋"
by unfold_locales (auto simp: OclAsBoolean⇩R⇩e⇩a⇩l_def bot_option_def)
subsection‹Definition: asInteger›
definition OclAsInteger⇩R⇩e⇩a⇩l :: "('𝔄) Real ⇒ ('𝔄) Integer" ("(_)->oclAsType⇩R⇩e⇩a⇩l'(Integer')")
where "OclAsInteger⇩R⇩e⇩a⇩l X = (λτ. if (δ X) τ = true τ
then ⌊⌊floor ⌈⌈X τ⌉⌉⌋⌋
else invalid τ)"
interpretation OclAsInteger⇩R⇩e⇩a⇩l : profile_mono⇩d OclAsInteger⇩R⇩e⇩a⇩l "λx. ⌊⌊floor ⌈⌈x⌉⌉⌋⌋"
by unfold_locales (auto simp: OclAsInteger⇩R⇩e⇩a⇩l_def bot_option_def)
subsection‹Definition: asReal›
definition OclAsReal⇩I⇩n⇩t :: "('𝔄) Integer ⇒ ('𝔄) Real" ("(_)->oclAsType⇩I⇩n⇩t'(Real')")
where "OclAsReal⇩I⇩n⇩t X = (λτ. if (δ X) τ = true τ
then ⌊⌊real_of_int ⌈⌈X τ⌉⌉⌋⌋
else invalid τ)"
interpretation OclAsReal⇩I⇩n⇩t : profile_mono⇩d OclAsReal⇩I⇩n⇩t "λx. ⌊⌊real_of_int ⌈⌈x⌉⌉⌋⌋"
by unfold_locales (auto simp: OclAsReal⇩I⇩n⇩t_def bot_option_def)
lemma Integer_subtype_of_Real:
assumes "τ ⊨ δ X"
shows "τ ⊨ X ->oclAsType⇩I⇩n⇩t(Real) ->oclAsType⇩R⇩e⇩a⇩l(Integer) ≜ X"
apply(insert assms, simp add: OclAsInteger⇩R⇩e⇩a⇩l_def OclAsReal⇩I⇩n⇩t_def OclValid_def StrongEq_def)
apply(subst (2 4) cp_defined, simp add: true_def)
by (metis assms bot_option_def drop.elims foundation16 null_option_def)
subsection‹Definition: asPair›
definition OclAsPair⇩S⇩e⇩q :: "[('𝔄,'α::null)Sequence]⇒('𝔄,'α::null,'α::null) Pair" ("(_)->asPair⇩S⇩e⇩q'(')")
where "OclAsPair⇩S⇩e⇩q S = (if S->size⇩S⇩e⇩q() ≐ 𝟮
then Pair{S->at⇩S⇩e⇩q(𝟬),S->at⇩S⇩e⇩q(𝟭)}
else invalid
endif)"
definition OclAsPair⇩S⇩e⇩t :: "[('𝔄,'α::null)Set]⇒('𝔄,'α::null,'α::null) Pair" ("(_)->asPair⇩S⇩e⇩t'(')")
where "OclAsPair⇩S⇩e⇩t S = (if S->size⇩S⇩e⇩t() ≐ 𝟮
then let v = S->any⇩S⇩e⇩t() in
Pair{v,S->excluding⇩S⇩e⇩t(v)->any⇩S⇩e⇩t()}
else invalid
endif)"
definition OclAsPair⇩B⇩a⇩g :: "[('𝔄,'α::null)Bag]⇒('𝔄,'α::null,'α::null) Pair" ("(_)->asPair⇩B⇩a⇩g'(')")
where "OclAsPair⇩B⇩a⇩g S = (if S->size⇩B⇩a⇩g() ≐ 𝟮
then let v = S->any⇩B⇩a⇩g() in
Pair{v,S->excluding⇩B⇩a⇩g(v)->any⇩B⇩a⇩g()}
else invalid
endif)"
subsection‹Definition: asSet›
definition OclAsSet⇩S⇩e⇩q :: "[('𝔄,'α::null)Sequence]⇒('𝔄,'α)Set" ("(_)->asSet⇩S⇩e⇩q'(')")
where "OclAsSet⇩S⇩e⇩q S = (S->iterate⇩S⇩e⇩q(b; x = Set{} | x ->including⇩S⇩e⇩t(b)))"
definition OclAsSet⇩P⇩a⇩i⇩r :: "[('𝔄,'α::null,'α::null) Pair]⇒('𝔄,'α)Set" ("(_)->asSet⇩P⇩a⇩i⇩r'(')")
where "OclAsSet⇩P⇩a⇩i⇩r S = Set{S .First(), S .Second()}"
definition OclAsSet⇩B⇩a⇩g :: "('𝔄,'α::null) Bag⇒('𝔄,'α)Set" ("(_)->asSet⇩B⇩a⇩g'(')")
where "OclAsSet⇩B⇩a⇩g S = (λ τ. if (δ S) τ = true τ
then Abs_Set⇩b⇩a⇩s⇩e⌊⌊ Rep_Set_base S τ ⌋⌋
else if (υ S) τ = true τ then null τ
else invalid τ)"
subsection‹Definition: asSequence›
definition OclAsSeq⇩S⇩e⇩t :: "[('𝔄,'α::null)Set]⇒('𝔄,'α)Sequence" ("(_)->asSequence⇩S⇩e⇩t'(')")
where "OclAsSeq⇩S⇩e⇩t S = (S->iterate⇩S⇩e⇩t(b; x = Sequence{} | x ->including⇩S⇩e⇩q(b)))"
definition OclAsSeq⇩B⇩a⇩g :: "[('𝔄,'α::null)Bag]⇒('𝔄,'α)Sequence" ("(_)->asSequence⇩B⇩a⇩g'(')")
where "OclAsSeq⇩B⇩a⇩g S = (S->iterate⇩B⇩a⇩g(b; x = Sequence{} | x ->including⇩S⇩e⇩q(b)))"
definition OclAsSeq⇩P⇩a⇩i⇩r :: "[('𝔄,'α::null,'α::null) Pair]⇒('𝔄,'α)Sequence" ("(_)->asSequence⇩P⇩a⇩i⇩r'(')")
where "OclAsSeq⇩P⇩a⇩i⇩r S = Sequence{S .First(), S .Second()}"
subsection‹Definition: asBag›
definition OclAsBag⇩S⇩e⇩q :: "[('𝔄,'α::null)Sequence]⇒('𝔄,'α)Bag" ("(_)->asBag⇩S⇩e⇩q'(')")
where "OclAsBag⇩S⇩e⇩q S = (λτ. Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊λs. if list_ex ((=) s) ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (S τ)⌉⌉ then 1 else 0⌋⌋)"
definition OclAsBag⇩S⇩e⇩t :: "[('𝔄,'α::null)Set]⇒('𝔄,'α)Bag" ("(_)->asBag⇩S⇩e⇩t'(')")
where "OclAsBag⇩S⇩e⇩t S = (λτ. Abs_Bag⇩b⇩a⇩s⇩e ⌊⌊λs. if s ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (S τ)⌉⌉ then 1 else 0⌋⌋)"
lemma assumes "τ ⊨ δ (S ->size⇩S⇩e⇩t())"
shows "OclAsBag⇩S⇩e⇩t S = (S->iterate⇩S⇩e⇩t(b; x = Bag{} | x ->including⇩B⇩a⇩g(b)))"
oops
definition OclAsBag⇩P⇩a⇩i⇩r :: "[('𝔄,'α::null,'α::null) Pair]⇒('𝔄,'α)Bag" ("(_)->asBag⇩P⇩a⇩i⇩r'(')")
where "OclAsBag⇩P⇩a⇩i⇩r S = Bag{S .First(), S .Second()}"
text_raw‹\isatagafp›
subsection‹Collection Types›
lemmas cp_intro'' [intro!,simp,code_unfold] =
cp_intro'
cp_intro''⇩S⇩e⇩t
cp_intro''⇩S⇩e⇩q
text_raw‹\endisatagafp›
subsection‹Test Statements›
lemma syntax_test: "Set{𝟮,𝟭} = (Set{}->including⇩S⇩e⇩t(𝟭)->including⇩S⇩e⇩t(𝟮))"
by (rule refl)
text‹Here is an example of a nested collection.›
lemma semantic_test2:
assumes H:"(Set{𝟮} ≐ null) = (false::('𝔄)Boolean)"
shows "(τ::('𝔄)st) ⊨ (Set{Set{𝟮},null}->includes⇩S⇩e⇩t(null))"
by(simp add: OclIncludes_execute⇩S⇩e⇩t H)
lemma short_cut'[simp,code_unfold]: "(𝟴 ≐ 𝟲) = false"
apply(rule ext)
apply(simp add: StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r StrongEq_def OclInt8_def OclInt6_def
true_def false_def invalid_def bot_option_def)
done
lemma short_cut''[simp,code_unfold]: "(𝟮 ≐ 𝟭) = false"
apply(rule ext)
apply(simp add: StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r StrongEq_def OclInt2_def OclInt1_def
true_def false_def invalid_def bot_option_def)
done
lemma short_cut'''[simp,code_unfold]: "(𝟭 ≐ 𝟮) = false"
apply(rule ext)
apply(simp add: StrictRefEq⇩I⇩n⇩t⇩e⇩g⇩e⇩r StrongEq_def OclInt2_def OclInt1_def
true_def false_def invalid_def bot_option_def)
done
Assert "τ ⊨ (𝟬 <⇩i⇩n⇩t 𝟮) and (𝟬 <⇩i⇩n⇩t 𝟭) "
text‹Elementary computations on Sets.›
declare OclSelect_body_def [simp]
Assert "¬ (τ ⊨ υ(invalid::('𝔄,'α::null) Set))"
Assert "τ ⊨ υ(null::('𝔄,'α::null) Set)"
Assert "¬ (τ ⊨ δ(null::('𝔄,'α::null) Set))"
Assert "τ ⊨ υ(Set{})"
Assert "τ ⊨ υ(Set{Set{𝟮},null})"
Assert "τ ⊨ δ(Set{Set{𝟮},null})"
Assert "τ ⊨ (Set{𝟮,𝟭}->includes⇩S⇩e⇩t(𝟭))"
Assert "¬ (τ ⊨ (Set{𝟮}->includes⇩S⇩e⇩t(𝟭)))"
Assert "¬ (τ ⊨ (Set{𝟮,𝟭}->includes⇩S⇩e⇩t(null)))"
Assert "τ ⊨ (Set{𝟮,null}->includes⇩S⇩e⇩t(null))"
Assert "τ ⊨ (Set{null,𝟮}->includes⇩S⇩e⇩t(null))"
Assert "τ ⊨ ((Set{})->forAll⇩S⇩e⇩t(z | 𝟬 <⇩i⇩n⇩t z))"
Assert "τ ⊨ ((Set{𝟮,𝟭})->forAll⇩S⇩e⇩t(z | 𝟬 <⇩i⇩n⇩t z))"
Assert "¬ (τ ⊨ ((Set{𝟮,𝟭})->exists⇩S⇩e⇩t(z | z <⇩i⇩n⇩t 𝟬 )))"
Assert "¬ (τ ⊨ (δ(Set{𝟮,null})->forAll⇩S⇩e⇩t(z | 𝟬 <⇩i⇩n⇩t z)))"
Assert "¬ (τ ⊨ ((Set{𝟮,null})->forAll⇩S⇩e⇩t(z | 𝟬 <⇩i⇩n⇩t z)))"
Assert "τ ⊨ ((Set{𝟮,null})->exists⇩S⇩e⇩t(z | 𝟬 <⇩i⇩n⇩t z))"
Assert "¬ (τ ⊨ (Set{null::'a Boolean} ≐ Set{}))"
Assert "¬ (τ ⊨ (Set{null::'a Integer} ≐ Set{}))"
Assert "¬ (τ ⊨ (Set{true} ≐ Set{false}))"
Assert "¬ (τ ⊨ (Set{true,true} ≐ Set{false}))"
Assert "¬ (τ ⊨ (Set{𝟮} ≐ Set{𝟭}))"
Assert "τ ⊨ (Set{𝟮,null,𝟮} ≐ Set{null,𝟮})"
Assert "τ ⊨ (Set{𝟭,null,𝟮} <> Set{null,𝟮})"
Assert "τ ⊨ (Set{Set{𝟮,null}} ≐ Set{Set{null,𝟮}})"
Assert "τ ⊨ (Set{Set{𝟮,null}} <> Set{Set{null,𝟮},null})"
Assert "τ ⊨ (Set{null}->select⇩S⇩e⇩t(x | not x) ≐ Set{null})"
Assert "τ ⊨ (Set{null}->reject⇩S⇩e⇩t(x | not x) ≐ Set{null})"
lemma "const (Set{Set{𝟮,null}, invalid})" by(simp add: const_ss)
text‹Elementary computations on Sequences.›
Assert "¬ (τ ⊨ υ(invalid::('𝔄,'α::null) Sequence))"
Assert "τ ⊨ υ(null::('𝔄,'α::null) Sequence)"
Assert "¬ (τ ⊨ δ(null::('𝔄,'α::null) Sequence))"
Assert "τ ⊨ υ(Sequence{})"
lemma "const (Sequence{Sequence{𝟮,null}, invalid})" by(simp add: const_ss)
end
Theory UML_State
chapter‹Formalization III: UML/OCL constructs: State Operations and Objects›
theory UML_State
imports UML_Library
begin
no_notation None ("⊥")
section‹Introduction: States over Typed Object Universes›
text‹\label{sec:universe}
In the following, we will refine the concepts of a user-defined
data-model (implied by a class-diagram) as well as the notion of
$\state{}$ used in the previous section to much more detail.
Surprisingly, even without a concrete notion of an objects and a
universe of object representation, the generic infrastructure of
state-related operations is fairly rich.
›
subsection‹Fundamental Properties on Objects: Core Referential Equality›
subsubsection‹Definition›
text‹Generic referential equality - to be used for instantiations
with concrete object types ...›
definition StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t :: "('𝔄,'a::{object,null})val ⇒ ('𝔄,'a)val ⇒ ('𝔄)Boolean"
where "StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x y
≡ λ τ. if (υ x) τ = true τ ∧ (υ y) τ = true τ
then if x τ = null ∨ y τ = null
then ⌊⌊x τ = null ∧ y τ = null⌋⌋
else ⌊⌊(oid_of (x τ)) = (oid_of (y τ)) ⌋⌋
else invalid τ"
subsubsection‹Strictness and context passing›
lemma StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_strict1[simp,code_unfold] :
"(StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x invalid) = invalid"
by(rule ext, simp add: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def true_def false_def)
lemma StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_strict2[simp,code_unfold] :
"(StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t invalid x) = invalid"
by(rule ext, simp add: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def true_def false_def)
lemma cp_StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t:
"(StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x y τ) = (StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t (λ_. x τ) (λ_. y τ)) τ"
by(auto simp: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def cp_valid[symmetric])
text_raw‹\isatagafp›
lemmas cp0_StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t= cp_StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t[THEN allI[THEN allI[THEN allI[THEN cpI2]],
of "StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t"]]
lemmas cp_intro''[intro!,simp,code_unfold] =
cp_intro''
cp_StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t[THEN allI[THEN allI[THEN allI[THEN cpI2]],
of "StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t"]]
text_raw‹\endisatagafp›
subsection‹Logic and Algebraic Layer on Object›
subsubsection‹Validity and Definedness Properties›
text‹We derive the usual laws on definedness for (generic) object equality:›
lemma StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_defargs:
"τ ⊨ (StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x (y::('𝔄,'a::{null,object})val))⟹ (τ ⊨(υ x)) ∧ (τ ⊨(υ y))"
by(simp add: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def OclValid_def true_def invalid_def bot_option_def
split: bool.split_asm HOL.if_split_asm)
lemma defined_StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_I:
assumes val_x : "τ ⊨ υ x"
assumes val_x : "τ ⊨ υ y"
shows "τ ⊨ δ (StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x y)"
apply(insert assms, simp add: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def OclValid_def)
by(subst cp_defined, simp add: true_def)
lemma StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def_homo :
"δ(StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x (y::('𝔄,'a::{null,object})val)) = ((υ x) and (υ y))"
oops
subsubsection‹Symmetry›
lemma StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_sym :
assumes x_val : "τ ⊨ υ x"
shows "τ ⊨ StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x x"
by(simp add: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def true_def OclValid_def
x_val[simplified OclValid_def])
subsubsection‹Behavior vs StrongEq›
text‹It remains to clarify the role of the state invariant
$\inv_\sigma(\sigma)$ mentioned above that states the condition that
there is a ``one-to-one'' correspondence between object
representations and $\oid$'s: $\forall \mathit{oid} \in \dom\ap
\sigma\spot oid = \HolOclOidOf\ap \drop{\sigma(\mathit{oid})}$. This
condition is also mentioned in~\cite[Annex A]{omg:ocl:2012} and goes
back to \citet{richters:precise:2002}; however, we state this
condition as an invariant on states rather than a global axiom. It
can, therefore, not be taken for granted that an $\oid$ makes sense
both in pre- and post-states of OCL expressions.
›
text‹We capture this invariant in the predicate WFF :›
definition WFF :: "('𝔄::object)st ⇒ bool"
where "WFF τ = ((∀ x ∈ ran(heap(fst τ)). ⌈heap(fst τ) (oid_of x)⌉ = x) ∧
(∀ x ∈ ran(heap(snd τ)). ⌈heap(snd τ) (oid_of x)⌉ = x))"
text‹It turns out that WFF is a key-concept for linking strict referential equality to
logical equality: in well-formed states (i.e. those states where the self (oid-of) field contains
the pointer to which the object is associated to in the state), referential equality coincides
with logical equality.›
text‹We turn now to the generic definition of referential equality on objects:
Equality on objects in a state is reduced to equality on the
references to these objects. As in HOL-OCL~\cite{brucker.ea:hol-ocl:2008,brucker.ea:hol-ocl-book:2006},
we will store the reference of an object inside the object in a (ghost) field.
By establishing certain invariants (``consistent state''), it can
be assured that there is a ``one-to-one-correspondence'' of objects
to their references---and therefore the definition below
behaves as we expect.›
text‹Generic Referential Equality enjoys the usual properties:
(quasi) reflexivity, symmetry, transitivity, substitutivity for
defined values. For type-technical reasons, for each concrete
object type, the equality ‹≐› is defined by generic referential
equality.›
theorem StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_vs_StrongEq:
assumes WFF: "WFF τ"
and valid_x: "τ ⊨(υ x)"
and valid_y: "τ ⊨(υ y)"
and x_present_pre: "x τ ∈ ran (heap(fst τ))"
and y_present_pre: "y τ ∈ ran (heap(fst τ))"
and x_present_post:"x τ ∈ ran (heap(snd τ))"
and y_present_post:"y τ ∈ ran (heap(snd τ))"
shows "(τ ⊨ (StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x y)) = (τ ⊨ (x ≜ y))"
apply(insert WFF valid_x valid_y x_present_pre y_present_pre x_present_post y_present_post)
apply(auto simp: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def OclValid_def WFF_def StrongEq_def true_def Ball_def)
apply(erule_tac x="x τ" in allE', simp_all)
done
theorem StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_vs_StrongEq':
assumes WFF: "WFF τ"
and valid_x: "τ ⊨(υ (x :: ('𝔄::object,'α::{null,object})val))"
and valid_y: "τ ⊨(υ y)"
and oid_preserve: "⋀x. x ∈ ran (heap(fst τ)) ∨ x ∈ ran (heap(snd τ)) ⟹
H x ≠ ⊥ ⟹ oid_of (H x) = oid_of x"
and xy_together: "x τ ∈ H ` ran (heap(fst τ)) ∧ y τ ∈ H ` ran (heap(fst τ)) ∨
x τ ∈ H ` ran (heap(snd τ)) ∧ y τ ∈ H ` ran (heap(snd τ))"
shows "(τ ⊨ (StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x y)) = (τ ⊨ (x ≜ y))"
apply(insert WFF valid_x valid_y xy_together)
apply(simp add: WFF_def)
apply(auto simp: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def OclValid_def WFF_def StrongEq_def true_def Ball_def)
by (metis foundation18' oid_preserve valid_x valid_y)+
text‹So, if two object descriptions live in the same state (both pre or post), the referential
equality on objects implies in a WFF state the logical equality.›
section‹Operations on Object›
subsection‹Initial States (for testing and code generation)›
definition τ⇩0 :: "('𝔄)st"
where "τ⇩0 ≡ (⦇heap=Map.empty, assocs = Map.empty⦈,
⦇heap=Map.empty, assocs = Map.empty⦈)"
subsection‹OclAllInstances›
text‹To denote OCL types occurring in OCL expressions syntactically---as, for example,
as ``argument'' of \inlineocl{oclAllInstances()}---we use the inverses of the injection functions into the object
universes; we show that this is a sufficient ``characterization.''›
definition OclAllInstances_generic :: "(('𝔄::object) st ⇒ '𝔄 state) ⇒ ('𝔄::object ⇀ 'α) ⇒
('𝔄, 'α option option) Set"
where "OclAllInstances_generic fst_snd H =
(λτ. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ Some ` ((H ` ran (heap (fst_snd τ))) - { None }) ⌋⌋)"
lemma OclAllInstances_generic_defined: "τ ⊨ δ (OclAllInstances_generic pre_post H)"
apply(simp add: defined_def OclValid_def OclAllInstances_generic_def false_def true_def
bot_fun_def bot_Set⇩b⇩a⇩s⇩e_def null_fun_def null_Set⇩b⇩a⇩s⇩e_def)
apply(rule conjI)
apply(rule notI, subst (asm) Abs_Set⇩b⇩a⇩s⇩e_inject, simp,
(rule disjI2)+,
metis bot_option_def option.distinct(1),
(simp add: bot_option_def null_option_def)+)+
done
lemma OclAllInstances_generic_init_empty:
assumes [simp]: "⋀x. pre_post (x, x) = x"
shows "τ⇩0 ⊨ OclAllInstances_generic pre_post H ≜ Set{}"
by(simp add: StrongEq_def OclAllInstances_generic_def OclValid_def τ⇩0_def mtSet_def)
lemma represented_generic_objects_nonnull:
assumes A: "τ ⊨ ((OclAllInstances_generic pre_post (H::('𝔄::object ⇀ 'α))) ->includes⇩S⇩e⇩t(x))"
shows "τ ⊨ not(x ≜ null)"
proof -
have B: "τ ⊨ δ (OclAllInstances_generic pre_post H)"
by (simp add: OclAllInstances_generic_defined)
have C: "τ ⊨ υ x"
by (metis OclIncludes.def_valid_then_def
OclIncludes_valid_args_valid A foundation6)
show ?thesis
apply(insert A)
apply(simp add: StrongEq_def OclValid_def
OclNot_def null_def true_def OclIncludes_def B[simplified OclValid_def]
C[simplified OclValid_def])
apply(simp add:OclAllInstances_generic_def)
apply(erule contrapos_pn)
apply(subst Set⇩b⇩a⇩s⇩e.Abs_Set⇩b⇩a⇩s⇩e_inverse,
auto simp: null_fun_def null_option_def bot_option_def)
done
qed
lemma represented_generic_objects_defined:
assumes A: "τ ⊨ ((OclAllInstances_generic pre_post (H::('𝔄::object ⇀ 'α))) ->includes⇩S⇩e⇩t(x))"
shows "τ ⊨ δ (OclAllInstances_generic pre_post H) ∧ τ ⊨ δ x"
by (metis OclAllInstances_generic_defined
A[THEN represented_generic_objects_nonnull] OclIncludes.defined_args_valid
A foundation16' foundation18 foundation24 foundation6)
text‹One way to establish the actual presence of an object representation in a state is:›
definition "is_represented_in_state fst_snd x H τ = (x τ ∈ (Some o H) ` ran (heap (fst_snd τ)))"
lemma represented_generic_objects_in_state:
assumes A: "τ ⊨ (OclAllInstances_generic pre_post H)->includes⇩S⇩e⇩t(x)"
shows "is_represented_in_state pre_post x H τ"
proof -
have B: "(δ (OclAllInstances_generic pre_post H)) τ = true τ"
by(simp add: OclValid_def[symmetric] OclAllInstances_generic_defined)
have C: "(υ x) τ = true τ"
by (metis OclValid_def UML_Set.OclIncludes_def assms bot_option_def option.distinct(1) true_def)
have F: "Rep_Set⇩b⇩a⇩s⇩e (Abs_Set⇩b⇩a⇩s⇩e ⌊⌊Some ` (H ` ran (heap (pre_post τ)) - {None})⌋⌋) =
⌊⌊Some ` (H ` ran (heap (pre_post τ)) - {None})⌋⌋"
by(subst Set⇩b⇩a⇩s⇩e.Abs_Set⇩b⇩a⇩s⇩e_inverse,simp_all add: bot_option_def)
show ?thesis
apply(insert A)
apply(simp add: is_represented_in_state_def OclIncludes_def OclValid_def ran_def B C image_def true_def)
apply(simp add: OclAllInstances_generic_def)
apply(simp add: F)
apply(simp add: ran_def)
by(fastforce)
qed
lemma state_update_vs_allInstances_generic_empty:
assumes [simp]: "⋀a. pre_post (mk a) = a"
shows "(mk ⦇heap=Map.empty, assocs=A⦈) ⊨ OclAllInstances_generic pre_post Type ≐ Set{}"
proof -
have state_update_vs_allInstances_empty:
"(OclAllInstances_generic pre_post Type) (mk ⦇heap=Map.empty, assocs=A⦈) =
Set{} (mk ⦇heap=Map.empty, assocs=A⦈)"
by(simp add: OclAllInstances_generic_def mtSet_def)
show ?thesis
apply(simp only: OclValid_def, subst StrictRefEq⇩S⇩e⇩t.cp0,
simp only: state_update_vs_allInstances_empty StrictRefEq⇩S⇩e⇩t.refl_ext)
apply(simp add: OclIf_def valid_def mtSet_def defined_def
bot_fun_def null_fun_def null_option_def bot_Set⇩b⇩a⇩s⇩e_def)
by(subst Abs_Set⇩b⇩a⇩s⇩e_inject, (simp add: bot_option_def true_def)+)
qed
text‹Here comes a couple of operational rules that allow to infer the value
of \inlineisar+oclAllInstances+ from the context $\tau$. These rules are a special-case
in the sense that they are the only rules that relate statements with \emph{different}
$\tau$'s. For that reason, new concepts like ``constant contexts P'' are necessary
(for which we do not elaborate an own theory for reasons of space limitations;
in examples, we will prove resulting constraints straight forward by hand).›
lemma state_update_vs_allInstances_generic_including':
assumes [simp]: "⋀a. pre_post (mk a) = a"
assumes "⋀x. σ' oid = Some x ⟹ x = Object"
and "Type Object ≠ None"
shows "(OclAllInstances_generic pre_post Type)
(mk ⦇heap=σ'(oid↦Object), assocs=A⦈)
=
((OclAllInstances_generic pre_post Type)->including⇩S⇩e⇩t(λ _. ⌊⌊ drop (Type Object) ⌋⌋))
(mk ⦇heap=σ',assocs=A⦈)"
proof -
have drop_none : "⋀x. x ≠ None ⟹ ⌊⌈x⌉⌋ = x"
by(case_tac x, simp+)
have insert_diff : "⋀x S. insert ⌊x⌋ (S - {None}) = (insert ⌊x⌋ S) - {None}"
by (metis insert_Diff_if option.distinct(1) singletonE)
show ?thesis
apply(simp add: UML_Set.OclIncluding_def OclAllInstances_generic_defined[simplified OclValid_def],
simp add: OclAllInstances_generic_def)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def, simp add: comp_def,
subst image_insert[symmetric],
subst drop_none, simp add: assms)
apply(case_tac "Type Object", simp add: assms, simp only:,
subst insert_diff, drule sym, simp)
apply(subgoal_tac "ran (σ'(oid ↦ Object)) = insert Object (ran σ')", simp)
apply(case_tac "¬ (∃x. σ' oid = Some x)")
apply(rule ran_map_upd, simp)
apply(simp, erule exE, frule assms, simp)
apply(subgoal_tac "Object ∈ ran σ'") prefer 2
apply(rule ranI, simp)
by(subst insert_absorb, simp, metis fun_upd_apply)
qed
lemma state_update_vs_allInstances_generic_including:
assumes [simp]: "⋀a. pre_post (mk a) = a"
assumes "⋀x. σ' oid = Some x ⟹ x = Object"
and "Type Object ≠ None"
shows "(OclAllInstances_generic pre_post Type)
(mk ⦇heap=σ'(oid↦Object), assocs=A⦈)
=
((λ_. (OclAllInstances_generic pre_post Type)
(mk ⦇heap=σ', assocs=A⦈))->including⇩S⇩e⇩t(λ _. ⌊⌊ drop (Type Object) ⌋⌋))
(mk ⦇heap=σ'(oid↦Object), assocs=A⦈)"
apply(subst state_update_vs_allInstances_generic_including', (simp add: assms)+,
subst UML_Set.OclIncluding.cp0,
simp add: UML_Set.OclIncluding_def)
apply(subst (1 3) cp_defined[symmetric],
simp add: OclAllInstances_generic_defined[simplified OclValid_def])
apply(simp add: defined_def OclValid_def OclAllInstances_generic_def invalid_def
bot_fun_def null_fun_def bot_Set⇩b⇩a⇩s⇩e_def null_Set⇩b⇩a⇩s⇩e_def)
apply(subst (1 3) Abs_Set⇩b⇩a⇩s⇩e_inject)
by(simp add: bot_option_def null_option_def)+
lemma state_update_vs_allInstances_generic_noincluding':
assumes [simp]: "⋀a. pre_post (mk a) = a"
assumes "⋀x. σ' oid = Some x ⟹ x = Object"
and "Type Object = None"
shows "(OclAllInstances_generic pre_post Type)
(mk ⦇heap=σ'(oid↦Object), assocs=A⦈)
=
(OclAllInstances_generic pre_post Type)
(mk ⦇heap=σ', assocs=A⦈)"
proof -
have drop_none : "⋀x. x ≠ None ⟹ ⌊⌈x⌉⌋ = x"
by(case_tac x, simp+)
have insert_diff : "⋀x S. insert ⌊x⌋ (S - {None}) = (insert ⌊x⌋ S) - {None}"
by (metis insert_Diff_if option.distinct(1) singletonE)
show ?thesis
apply(simp add: OclIncluding_def OclAllInstances_generic_defined[simplified OclValid_def]
OclAllInstances_generic_def)
apply(subgoal_tac "ran (σ'(oid ↦ Object)) = insert Object (ran σ')", simp add: assms)
apply(case_tac "¬ (∃x. σ' oid = Some x)")
apply(rule ran_map_upd, simp)
apply(simp, erule exE, frule assms, simp)
apply(subgoal_tac "Object ∈ ran σ'") prefer 2
apply(rule ranI, simp)
apply(subst insert_absorb, simp)
by (metis fun_upd_apply)
qed
theorem state_update_vs_allInstances_generic_ntc:
assumes [simp]: "⋀a. pre_post (mk a) = a"
assumes oid_def: "oid∉dom σ'"
and non_type_conform: "Type Object = None "
and cp_ctxt: "cp P"
and const_ctxt: "⋀X. const X ⟹ const (P X)"
shows "(mk ⦇heap=σ'(oid↦Object),assocs=A⦈ ⊨ P (OclAllInstances_generic pre_post Type)) =
(mk ⦇heap=σ', assocs=A⦈ ⊨ P (OclAllInstances_generic pre_post Type))"
(is "(?τ ⊨ P ?φ) = (?τ' ⊨ P ?φ)")
proof -
have P_cp : "⋀x τ. P x τ = P (λ_. x τ) τ"
by (metis (full_types) cp_ctxt cp_def)
have A : "const (P (λ_. ?φ ?τ))"
by(simp add: const_ctxt const_ss)
have "(?τ ⊨ P ?φ) = (?τ ⊨ λ_. P ?φ ?τ)"
by(subst foundation23, rule refl)
also have "... = (?τ ⊨ λ_. P (λ_. ?φ ?τ) ?τ)"
by(subst P_cp, rule refl)
also have "... = (?τ' ⊨ λ_. P (λ_. ?φ ?τ) ?τ')"
apply(simp add: OclValid_def)
by(subst A[simplified const_def], subst const_true[simplified const_def], simp)
finally have X: "(?τ ⊨ P ?φ) = (?τ' ⊨ λ_. P (λ_. ?φ ?τ) ?τ')"
by simp
show ?thesis
apply(subst X) apply(subst foundation23[symmetric])
apply(rule StrongEq_L_subst3[OF cp_ctxt])
apply(simp add: OclValid_def StrongEq_def true_def)
apply(rule state_update_vs_allInstances_generic_noincluding')
by(insert oid_def, auto simp: non_type_conform)
qed
theorem state_update_vs_allInstances_generic_tc:
assumes [simp]: "⋀a. pre_post (mk a) = a"
assumes oid_def: "oid∉dom σ'"
and type_conform: "Type Object ≠ None "
and cp_ctxt: "cp P"
and const_ctxt: "⋀X. const X ⟹ const (P X)"
shows "(mk ⦇heap=σ'(oid↦Object),assocs=A⦈ ⊨ P (OclAllInstances_generic pre_post Type)) =
(mk ⦇heap=σ', assocs=A⦈ ⊨ P ((OclAllInstances_generic pre_post Type)
->including⇩S⇩e⇩t(λ _. ⌊(Type Object)⌋)))"
(is "(?τ ⊨ P ?φ) = (?τ' ⊨ P ?φ')")
proof -
have P_cp : "⋀x τ. P x τ = P (λ_. x τ) τ"
by (metis (full_types) cp_ctxt cp_def)
have A : "const (P (λ_. ?φ ?τ))"
by(simp add: const_ctxt const_ss)
have "(?τ ⊨ P ?φ) = (?τ ⊨ λ_. P ?φ ?τ)"
by(subst foundation23, rule refl)
also have "... = (?τ ⊨ λ_. P (λ_. ?φ ?τ) ?τ)"
by(subst P_cp, rule refl)
also have "... = (?τ' ⊨ λ_. P (λ_. ?φ ?τ) ?τ')"
apply(simp add: OclValid_def)
by(subst A[simplified const_def], subst const_true[simplified const_def], simp)
finally have X: "(?τ ⊨ P ?φ) = (?τ' ⊨ λ_. P (λ_. ?φ ?τ) ?τ')"
by simp
let ?allInstances = "OclAllInstances_generic pre_post Type"
have "?allInstances ?τ = λ_. ?allInstances ?τ'->including⇩S⇩e⇩t(λ_.⌊⌊⌈Type Object⌉⌋⌋) ?τ"
apply(rule state_update_vs_allInstances_generic_including)
by(insert oid_def, auto simp: type_conform)
also have "... = ((λ_. ?allInstances ?τ')->including⇩S⇩e⇩t(λ_. (λ_.⌊⌊⌈Type Object⌉⌋⌋) ?τ') ?τ')"
by(subst const_OclIncluding[simplified const_def], simp+)
also have "... = (?allInstances->including⇩S⇩e⇩t(λ _. ⌊Type Object⌋) ?τ')"
apply(subst UML_Set.OclIncluding.cp0[symmetric])
by(insert type_conform, auto)
finally have Y : "?allInstances ?τ = (?allInstances->including⇩S⇩e⇩t(λ _. ⌊Type Object⌋) ?τ')"
by auto
show ?thesis
apply(subst X) apply(subst foundation23[symmetric])
apply(rule StrongEq_L_subst3[OF cp_ctxt])
apply(simp add: OclValid_def StrongEq_def Y true_def)
done
qed
declare OclAllInstances_generic_def [simp]
subsubsection‹OclAllInstances (@post)›
definition OclAllInstances_at_post :: "('𝔄 :: object ⇀ 'α) ⇒ ('𝔄, 'α option option) Set"
("_ .allInstances'(')")
where "OclAllInstances_at_post = OclAllInstances_generic snd"
lemma OclAllInstances_at_post_defined: "τ ⊨ δ (H .allInstances())"
unfolding OclAllInstances_at_post_def
by(rule OclAllInstances_generic_defined)
lemma "τ⇩0 ⊨ H .allInstances() ≜ Set{}"
unfolding OclAllInstances_at_post_def
by(rule OclAllInstances_generic_init_empty, simp)
lemma represented_at_post_objects_nonnull:
assumes A: "τ ⊨ (((H::('𝔄::object ⇀ 'α)).allInstances()) ->includes⇩S⇩e⇩t(x))"
shows "τ ⊨ not(x ≜ null)"
by(rule represented_generic_objects_nonnull[OF A[simplified OclAllInstances_at_post_def]])
lemma represented_at_post_objects_defined:
assumes A: "τ ⊨ (((H::('𝔄::object ⇀ 'α)).allInstances()) ->includes⇩S⇩e⇩t(x))"
shows "τ ⊨ δ (H .allInstances()) ∧ τ ⊨ δ x"
unfolding OclAllInstances_at_post_def
by(rule represented_generic_objects_defined[OF A[simplified OclAllInstances_at_post_def]])
text‹One way to establish the actual presence of an object representation in a state is:›
lemma
assumes A: "τ ⊨ H .allInstances()->includes⇩S⇩e⇩t(x)"
shows "is_represented_in_state snd x H τ"
by(rule represented_generic_objects_in_state[OF A[simplified OclAllInstances_at_post_def]])
lemma state_update_vs_allInstances_at_post_empty:
shows "(σ, ⦇heap=Map.empty, assocs=A⦈) ⊨ Type .allInstances() ≐ Set{}"
unfolding OclAllInstances_at_post_def
by(rule state_update_vs_allInstances_generic_empty[OF snd_conv])
text‹Here comes a couple of operational rules that allow to infer the value
of \inlineisar+oclAllInstances+ from the context $\tau$. These rules are a special-case
in the sense that they are the only rules that relate statements with \emph{different}
$\tau$'s. For that reason, new concepts like ``constant contexts P'' are necessary
(for which we do not elaborate an own theory for reasons of space limitations;
in examples, we will prove resulting constraints straight forward by hand).›
lemma state_update_vs_allInstances_at_post_including':
assumes "⋀x. σ' oid = Some x ⟹ x = Object"
and "Type Object ≠ None"
shows "(Type .allInstances())
(σ, ⦇heap=σ'(oid↦Object), assocs=A⦈)
=
((Type .allInstances())->including⇩S⇩e⇩t(λ _. ⌊⌊ drop (Type Object) ⌋⌋))
(σ, ⦇heap=σ',assocs=A⦈)"
unfolding OclAllInstances_at_post_def
by(rule state_update_vs_allInstances_generic_including'[OF snd_conv], insert assms)
lemma state_update_vs_allInstances_at_post_including:
assumes "⋀x. σ' oid = Some x ⟹ x = Object"
and "Type Object ≠ None"
shows "(Type .allInstances())
(σ, ⦇heap=σ'(oid↦Object), assocs=A⦈)
=
((λ_. (Type .allInstances())
(σ, ⦇heap=σ', assocs=A⦈))->including⇩S⇩e⇩t(λ _. ⌊⌊ drop (Type Object) ⌋⌋))
(σ, ⦇heap=σ'(oid↦Object), assocs=A⦈)"
unfolding OclAllInstances_at_post_def
by(rule state_update_vs_allInstances_generic_including[OF snd_conv], insert assms)
lemma state_update_vs_allInstances_at_post_noincluding':
assumes "⋀x. σ' oid = Some x ⟹ x = Object"
and "Type Object = None"
shows "(Type .allInstances())
(σ, ⦇heap=σ'(oid↦Object), assocs=A⦈)
=
(Type .allInstances())
(σ, ⦇heap=σ', assocs=A⦈)"
unfolding OclAllInstances_at_post_def
by(rule state_update_vs_allInstances_generic_noincluding'[OF snd_conv], insert assms)
theorem state_update_vs_allInstances_at_post_ntc:
assumes oid_def: "oid∉dom σ'"
and non_type_conform: "Type Object = None "
and cp_ctxt: "cp P"
and const_ctxt: "⋀X. const X ⟹ const (P X)"
shows "((σ, ⦇heap=σ'(oid↦Object),assocs=A⦈) ⊨ (P(Type .allInstances()))) =
((σ, ⦇heap=σ', assocs=A⦈) ⊨ (P(Type .allInstances())))"
unfolding OclAllInstances_at_post_def
by(rule state_update_vs_allInstances_generic_ntc[OF snd_conv], insert assms)
theorem state_update_vs_allInstances_at_post_tc:
assumes oid_def: "oid∉dom σ'"
and type_conform: "Type Object ≠ None "
and cp_ctxt: "cp P"
and const_ctxt: "⋀X. const X ⟹ const (P X)"
shows "((σ, ⦇heap=σ'(oid↦Object),assocs=A⦈) ⊨ (P(Type .allInstances()))) =
((σ, ⦇heap=σ', assocs=A⦈) ⊨ (P((Type .allInstances())
->including⇩S⇩e⇩t(λ _. ⌊(Type Object)⌋))))"
unfolding OclAllInstances_at_post_def
by(rule state_update_vs_allInstances_generic_tc[OF snd_conv], insert assms)
subsubsection‹OclAllInstances (@pre)›
definition OclAllInstances_at_pre :: "('𝔄 :: object ⇀ 'α) ⇒ ('𝔄, 'α option option) Set"
("_ .allInstances@pre'(')")
where "OclAllInstances_at_pre = OclAllInstances_generic fst"
lemma OclAllInstances_at_pre_defined: "τ ⊨ δ (H .allInstances@pre())"
unfolding OclAllInstances_at_pre_def
by(rule OclAllInstances_generic_defined)
lemma "τ⇩0 ⊨ H .allInstances@pre() ≜ Set{}"
unfolding OclAllInstances_at_pre_def
by(rule OclAllInstances_generic_init_empty, simp)
lemma represented_at_pre_objects_nonnull:
assumes A: "τ ⊨ (((H::('𝔄::object ⇀ 'α)).allInstances@pre()) ->includes⇩S⇩e⇩t(x))"
shows "τ ⊨ not(x ≜ null)"
by(rule represented_generic_objects_nonnull[OF A[simplified OclAllInstances_at_pre_def]])
lemma represented_at_pre_objects_defined:
assumes A: "τ ⊨ (((H::('𝔄::object ⇀ 'α)).allInstances@pre()) ->includes⇩S⇩e⇩t(x))"
shows "τ ⊨ δ (H .allInstances@pre()) ∧ τ ⊨ δ x"
unfolding OclAllInstances_at_pre_def
by(rule represented_generic_objects_defined[OF A[simplified OclAllInstances_at_pre_def]])
text‹One way to establish the actual presence of an object representation in a state is:›
lemma
assumes A: "τ ⊨ H .allInstances@pre()->includes⇩S⇩e⇩t(x)"
shows "is_represented_in_state fst x H τ"
by(rule represented_generic_objects_in_state[OF A[simplified OclAllInstances_at_pre_def]])
lemma state_update_vs_allInstances_at_pre_empty:
shows "(⦇heap=Map.empty, assocs=A⦈, σ) ⊨ Type .allInstances@pre() ≐ Set{}"
unfolding OclAllInstances_at_pre_def
by(rule state_update_vs_allInstances_generic_empty[OF fst_conv])
text‹Here comes a couple of operational rules that allow to infer the value
of \inlineisar+oclAllInstances@pre+ from the context $\tau$. These rules are a special-case
in the sense that they are the only rules that relate statements with \emph{different}
$\tau$'s. For that reason, new concepts like ``constant contexts P'' are necessary
(for which we do not elaborate an own theory for reasons of space limitations;
in examples, we will prove resulting constraints straight forward by hand).›
lemma state_update_vs_allInstances_at_pre_including':
assumes "⋀x. σ' oid = Some x ⟹ x = Object"
and "Type Object ≠ None"
shows "(Type .allInstances@pre())
(⦇heap=σ'(oid↦Object), assocs=A⦈, σ)
=
((Type .allInstances@pre())->including⇩S⇩e⇩t(λ _. ⌊⌊ drop (Type Object) ⌋⌋))
(⦇heap=σ',assocs=A⦈, σ)"
unfolding OclAllInstances_at_pre_def
by(rule state_update_vs_allInstances_generic_including'[OF fst_conv], insert assms)
lemma state_update_vs_allInstances_at_pre_including:
assumes "⋀x. σ' oid = Some x ⟹ x = Object"
and "Type Object ≠ None"
shows "(Type .allInstances@pre())
(⦇heap=σ'(oid↦Object), assocs=A⦈, σ)
=
((λ_. (Type .allInstances@pre())
(⦇heap=σ', assocs=A⦈, σ))->including⇩S⇩e⇩t(λ _. ⌊⌊ drop (Type Object) ⌋⌋))
(⦇heap=σ'(oid↦Object), assocs=A⦈, σ)"
unfolding OclAllInstances_at_pre_def
by(rule state_update_vs_allInstances_generic_including[OF fst_conv], insert assms)
lemma state_update_vs_allInstances_at_pre_noincluding':
assumes "⋀x. σ' oid = Some x ⟹ x = Object"
and "Type Object = None"
shows "(Type .allInstances@pre())
(⦇heap=σ'(oid↦Object), assocs=A⦈, σ)
=
(Type .allInstances@pre())
(⦇heap=σ', assocs=A⦈, σ)"
unfolding OclAllInstances_at_pre_def
by(rule state_update_vs_allInstances_generic_noincluding'[OF fst_conv], insert assms)
theorem state_update_vs_allInstances_at_pre_ntc:
assumes oid_def: "oid∉dom σ'"
and non_type_conform: "Type Object = None "
and cp_ctxt: "cp P"
and const_ctxt: "⋀X. const X ⟹ const (P X)"
shows "((⦇heap=σ'(oid↦Object),assocs=A⦈, σ) ⊨ (P(Type .allInstances@pre()))) =
((⦇heap=σ', assocs=A⦈, σ) ⊨ (P(Type .allInstances@pre())))"
unfolding OclAllInstances_at_pre_def
by(rule state_update_vs_allInstances_generic_ntc[OF fst_conv], insert assms)
theorem state_update_vs_allInstances_at_pre_tc:
assumes oid_def: "oid∉dom σ'"
and type_conform: "Type Object ≠ None "
and cp_ctxt: "cp P"
and const_ctxt: "⋀X. const X ⟹ const (P X)"
shows "((⦇heap=σ'(oid↦Object),assocs=A⦈, σ) ⊨ (P(Type .allInstances@pre()))) =
((⦇heap=σ', assocs=A⦈, σ) ⊨ (P((Type .allInstances@pre())
->including⇩S⇩e⇩t(λ _. ⌊(Type Object)⌋))))"
unfolding OclAllInstances_at_pre_def
by(rule state_update_vs_allInstances_generic_tc[OF fst_conv], insert assms)
subsubsection‹@post or @pre›
theorem StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_vs_StrongEq'':
assumes WFF: "WFF τ"
and valid_x: "τ ⊨(υ (x :: ('𝔄::object,'α::object option option)val))"
and valid_y: "τ ⊨(υ y)"
and oid_preserve: "⋀x. x ∈ ran (heap(fst τ)) ∨ x ∈ ran (heap(snd τ)) ⟹
oid_of (H x) = oid_of x"
and xy_together: "τ ⊨ ((H .allInstances()->includes⇩S⇩e⇩t(x) and H .allInstances()->includes⇩S⇩e⇩t(y)) or
(H .allInstances@pre()->includes⇩S⇩e⇩t(x) and H .allInstances@pre()->includes⇩S⇩e⇩t(y)))"
shows "(τ ⊨ (StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x y)) = (τ ⊨ (x ≜ y))"
proof -
have at_post_def : "⋀x. τ ⊨ υ x ⟹ τ ⊨ δ (H .allInstances()->includes⇩S⇩e⇩t(x))"
apply(simp add: OclIncludes_def OclValid_def
OclAllInstances_at_post_defined[simplified OclValid_def])
by(subst cp_defined, simp)
have at_pre_def : "⋀x. τ ⊨ υ x ⟹ τ ⊨ δ (H .allInstances@pre()->includes⇩S⇩e⇩t(x))"
apply(simp add: OclIncludes_def OclValid_def
OclAllInstances_at_pre_defined[simplified OclValid_def])
by(subst cp_defined, simp)
have F: "Rep_Set⇩b⇩a⇩s⇩e (Abs_Set⇩b⇩a⇩s⇩e ⌊⌊Some ` (H ` ran (heap (fst τ)) - {None})⌋⌋) =
⌊⌊Some ` (H ` ran (heap (fst τ)) - {None})⌋⌋"
by(subst Set⇩b⇩a⇩s⇩e.Abs_Set⇩b⇩a⇩s⇩e_inverse,simp_all add: bot_option_def)
have F': "Rep_Set⇩b⇩a⇩s⇩e (Abs_Set⇩b⇩a⇩s⇩e ⌊⌊Some ` (H ` ran (heap (snd τ)) - {None})⌋⌋) =
⌊⌊Some ` (H ` ran (heap (snd τ)) - {None})⌋⌋"
by(subst Set⇩b⇩a⇩s⇩e.Abs_Set⇩b⇩a⇩s⇩e_inverse,simp_all add: bot_option_def)
show ?thesis
apply(rule StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_vs_StrongEq'[OF WFF valid_x valid_y, where H = "Some o H"])
apply(subst oid_preserve[symmetric], simp, simp add: oid_of_option_def)
apply(insert xy_together,
subst (asm) foundation11,
metis at_post_def defined_and_I valid_x valid_y,
metis at_pre_def defined_and_I valid_x valid_y)
apply(erule disjE)
by(drule foundation5,
simp add: OclAllInstances_at_pre_def OclAllInstances_at_post_def
OclValid_def OclIncludes_def true_def F F'
valid_x[simplified OclValid_def] valid_y[simplified OclValid_def] bot_option_def
split: if_split_asm,
simp add: comp_def image_def, fastforce)+
qed
subsection‹OclIsNew, OclIsDeleted, OclIsMaintained, OclIsAbsent›
definition OclIsNew:: "('𝔄, 'α::{null,object})val ⇒ ('𝔄)Boolean" ("(_).oclIsNew'(')")
where "X .oclIsNew() ≡ (λτ . if (δ X) τ = true τ
then ⌊⌊oid_of (X τ) ∉ dom(heap(fst τ)) ∧
oid_of (X τ) ∈ dom(heap(snd τ))⌋⌋
else invalid τ)"
text‹The following predicates --- which are not part of the OCL standard descriptions ---
complete the goal of \inlineisar+oclIsNew+ by describing where an object belongs.
›
definition OclIsDeleted:: "('𝔄, 'α::{null,object})val ⇒ ('𝔄)Boolean" ("(_).oclIsDeleted'(')")
where "X .oclIsDeleted() ≡ (λτ . if (δ X) τ = true τ
then ⌊⌊oid_of (X τ) ∈ dom(heap(fst τ)) ∧
oid_of (X τ) ∉ dom(heap(snd τ))⌋⌋
else invalid τ)"
definition OclIsMaintained:: "('𝔄, 'α::{null,object})val ⇒ ('𝔄)Boolean"("(_).oclIsMaintained'(')")
where "X .oclIsMaintained() ≡ (λτ . if (δ X) τ = true τ
then ⌊⌊oid_of (X τ) ∈ dom(heap(fst τ)) ∧
oid_of (X τ) ∈ dom(heap(snd τ))⌋⌋
else invalid τ)"
definition OclIsAbsent:: "('𝔄, 'α::{null,object})val ⇒ ('𝔄)Boolean" ("(_).oclIsAbsent'(')")
where "X .oclIsAbsent() ≡ (λτ . if (δ X) τ = true τ
then ⌊⌊oid_of (X τ) ∉ dom(heap(fst τ)) ∧
oid_of (X τ) ∉ dom(heap(snd τ))⌋⌋
else invalid τ)"
lemma state_split : "τ ⊨ δ X ⟹
τ ⊨ (X .oclIsNew()) ∨ τ ⊨ (X .oclIsDeleted()) ∨
τ ⊨ (X .oclIsMaintained()) ∨ τ ⊨ (X .oclIsAbsent())"
by(simp add: OclIsDeleted_def OclIsNew_def OclIsMaintained_def OclIsAbsent_def
OclValid_def true_def, blast)
lemma notNew_vs_others : "τ ⊨ δ X ⟹
(¬ τ ⊨ (X .oclIsNew())) = (τ ⊨ (X .oclIsDeleted()) ∨
τ ⊨ (X .oclIsMaintained()) ∨ τ ⊨ (X .oclIsAbsent()))"
by(simp add: OclIsDeleted_def OclIsNew_def OclIsMaintained_def OclIsAbsent_def
OclNot_def OclValid_def true_def, blast)
subsection‹OclIsModifiedOnly›
subsubsection‹Definition›
text‹The following predicate---which is not part of the OCL
standard---provides a simple, but powerful means to describe framing
conditions. For any formal approach, be it animation of OCL contracts,
test-case generation or die-hard theorem proving, the specification of
the part of a system transition that \emph{does not change} is of
primordial importance. The following operator establishes the equality
between old and new objects in the state (provided that they exist in
both states), with the exception of those objects.›
definition OclIsModifiedOnly ::"('𝔄::object,'α::{null,object})Set ⇒ '𝔄 Boolean"
("_->oclIsModifiedOnly'(')")
where "X->oclIsModifiedOnly() ≡ (λ(σ,σ').
let X' = (oid_of ` ⌈⌈Rep_Set⇩b⇩a⇩s⇩e(X(σ,σ'))⌉⌉);
S = ((dom (heap σ) ∩ dom (heap σ')) - X')
in if (δ X) (σ,σ') = true (σ,σ') ∧ (∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e(X(σ,σ'))⌉⌉. x ≠ null)
then ⌊⌊∀ x ∈ S. (heap σ) x = (heap σ') x⌋⌋
else invalid (σ,σ'))"
subsubsection‹Execution with Invalid or Null or Null Element as Argument›
lemma "invalid->oclIsModifiedOnly() = invalid"
by(simp add: OclIsModifiedOnly_def)
lemma "null->oclIsModifiedOnly() = invalid"
by(simp add: OclIsModifiedOnly_def)
lemma
assumes X_null : "τ ⊨ X->includes⇩S⇩e⇩t(null)"
shows "τ ⊨ X->oclIsModifiedOnly() ≜ invalid"
apply(insert X_null,
simp add : OclIncludes_def OclIsModifiedOnly_def StrongEq_def OclValid_def true_def)
apply(case_tac τ, simp)
apply(simp split: if_split_asm)
by(simp add: null_fun_def, blast)
subsubsection‹Context Passing›
lemma cp_OclIsModifiedOnly : "X->oclIsModifiedOnly() τ = (λ_. X τ)->oclIsModifiedOnly() τ"
by(simp only: OclIsModifiedOnly_def, case_tac τ, simp only:, subst cp_defined, simp)
subsection‹OclSelf›
text‹The following predicate---which is not part of the OCL
standard---explicitly retrieves in the pre or post state the original OCL expression
given as argument.›
definition [simp]: "OclSelf x H fst_snd = (λτ . if (δ x) τ = true τ
then if oid_of (x τ) ∈ dom(heap(fst τ)) ∧ oid_of (x τ) ∈ dom(heap (snd τ))
then H ⌈(heap(fst_snd τ))(oid_of (x τ))⌉
else invalid τ
else invalid τ)"
definition OclSelf_at_pre :: "('𝔄::object,'α::{null,object})val ⇒
('𝔄 ⇒ 'α) ⇒
('𝔄::object,'α::{null,object})val" ("(_)@pre(_)")
where "x @pre H = OclSelf x H fst"
definition OclSelf_at_post :: "('𝔄::object,'α::{null,object})val ⇒
('𝔄 ⇒ 'α) ⇒
('𝔄::object,'α::{null,object})val" ("(_)@post(_)")
where "x @post H = OclSelf x H snd"
subsection‹Framing Theorem›
lemma all_oid_diff:
assumes def_x : "τ ⊨ δ x"
assumes def_X : "τ ⊨ δ X"
assumes def_X' : "⋀x. x ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ ⟹ x ≠ null"
defines "P ≡ (λa. not (StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x a))"
shows "(τ ⊨ X->forAll⇩S⇩e⇩t(a| P a)) = (oid_of (x τ) ∉ oid_of ` ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉)"
proof -
have P_null_bot: "⋀b. b = null ∨ b = ⊥ ⟹
¬ (∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. P (λ(_:: 'a state × 'a state). x) τ = b τ)"
apply(erule disjE)
apply(simp, rule ballI,
simp add: P_def StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def, rename_tac x',
subst cp_OclNot, simp,
subgoal_tac "x τ ≠ null ∧ x' ≠ null", simp,
simp add: OclNot_def null_fun_def null_option_def bot_option_def bot_fun_def invalid_def,
( metis def_X' def_x foundation16[THEN iffD1]
| (metis bot_fun_def OclValid_def Set_inv_lemma def_X def_x defined_def valid_def,
metis def_X' def_x foundation16[THEN iffD1])))+
done
have not_inj : "⋀x y. ((not x) τ = (not y) τ) = (x τ = y τ)"
by (metis foundation21 foundation22)
have P_false : "∃x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. P (λ_. x) τ = false τ ⟹
oid_of (x τ) ∈ oid_of ` ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
apply(erule bexE, rename_tac x')
apply(simp add: P_def)
apply(simp only: OclNot3[symmetric], simp only: not_inj)
apply(simp add: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def split: if_split_asm)
apply(subgoal_tac "x τ ≠ null ∧ x' ≠ null", simp)
apply (metis (mono_tags) drop.simps def_x foundation16[THEN iffD1] true_def)
by(simp add: invalid_def bot_option_def true_def)+
have P_true : "∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. P (λ_. x) τ = true τ ⟹
oid_of (x τ) ∉ oid_of ` ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
apply(subgoal_tac "∀x'∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. oid_of x' ≠ oid_of (x τ)")
apply (metis imageE)
apply(rule ballI, drule_tac x = "x'" in ballE) prefer 3 apply assumption
apply(simp add: P_def)
apply(simp only: OclNot4[symmetric], simp only: not_inj)
apply(simp add: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def false_def split: if_split_asm)
apply(subgoal_tac "x τ ≠ null ∧ x' ≠ null", simp)
apply (metis def_X' def_x foundation16[THEN iffD1])
by(simp add: invalid_def bot_option_def false_def)+
have bool_split : "∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. P (λ_. x) τ ≠ null τ ⟹
∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. P (λ_. x) τ ≠ ⊥ τ ⟹
∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. P (λ_. x) τ ≠ false τ ⟹
∀x∈⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉. P (λ_. x) τ = true τ"
apply(rule ballI)
apply(drule_tac x = x in ballE) prefer 3 apply assumption
apply(drule_tac x = x in ballE) prefer 3 apply assumption
apply(drule_tac x = x in ballE) prefer 3 apply assumption
apply (metis (full_types) bot_fun_def OclNot4 OclValid_def foundation16
foundation9 not_inj null_fun_def)
by(fast+)
show ?thesis
apply(subst OclForall_rep_set_true[OF def_X], simp add: OclValid_def)
apply(rule iffI, simp add: P_true)
by (metis P_false P_null_bot bool_split)
qed
theorem framing:
assumes modifiesclause:"τ ⊨ (X->excluding⇩S⇩e⇩t(x))->oclIsModifiedOnly()"
and oid_is_typerepr : "τ ⊨ X->forAll⇩S⇩e⇩t(a| not (StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x a))"
shows "τ ⊨ (x @pre P ≜ (x @post P))"
apply(case_tac "τ ⊨ δ x")
proof - show "τ ⊨ δ x ⟹ ?thesis" proof - assume def_x : "τ ⊨ δ x" show ?thesis proof -
have def_X : "τ ⊨ δ X"
apply(insert oid_is_typerepr, simp add: UML_Set.OclForall_def OclValid_def split: if_split_asm)
by(simp add: bot_option_def true_def)
have def_X' : "⋀x. x ∈ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉ ⟹ x ≠ null"
apply(insert modifiesclause, simp add: OclIsModifiedOnly_def OclValid_def split: if_split_asm)
apply(case_tac τ, simp split: if_split_asm)
apply(simp add: UML_Set.OclExcluding_def split: if_split_asm)
apply(subst (asm) (2) Abs_Set⇩b⇩a⇩s⇩e_inverse)
apply(simp, (rule disjI2)+)
apply (metis (hide_lams, mono_tags) Diff_iff Set_inv_lemma def_X)
apply(simp)
apply(erule ballE[where P = "λx. x ≠ null"]) apply(assumption)
apply(simp)
apply (metis (hide_lams, no_types) def_x foundation16[THEN iffD1])
apply (metis (hide_lams, no_types) OclValid_def def_X def_x foundation20
OclExcluding_valid_args_valid OclExcluding_valid_args_valid'')
by(simp add: invalid_def bot_option_def)
have oid_is_typerepr : "oid_of (x τ) ∉ oid_of ` ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (X τ)⌉⌉"
by(rule all_oid_diff[THEN iffD1, OF def_x def_X def_X' oid_is_typerepr])
show ?thesis
apply(simp add: StrongEq_def OclValid_def true_def OclSelf_at_pre_def OclSelf_at_post_def
def_x[simplified OclValid_def])
apply(rule conjI, rule impI)
apply(rule_tac f = "λx. P ⌈x⌉" in arg_cong)
apply(insert modifiesclause[simplified OclIsModifiedOnly_def OclValid_def])
apply(case_tac τ, rename_tac σ σ', simp split: if_split_asm)
apply(subst (asm) (2) UML_Set.OclExcluding_def)
apply(drule foundation5[simplified OclValid_def true_def], simp)
apply(subst (asm) Abs_Set⇩b⇩a⇩s⇩e_inverse, simp)
apply(rule disjI2)+
apply (metis (hide_lams, no_types) DiffD1 OclValid_def Set_inv_lemma def_x
foundation16 foundation18')
apply(simp)
apply(erule_tac x = "oid_of (x (σ, σ'))" in ballE) apply simp+
apply (metis (hide_lams, no_types)
DiffD1 image_iff image_insert insert_Diff_single insert_absorb oid_is_typerepr)
apply(simp add: invalid_def bot_option_def)+
by blast
qed qed
qed(simp add: OclSelf_at_post_def OclSelf_at_pre_def OclValid_def StrongEq_def true_def)+
text‹As corollary, the framing property can be expressed with only the strong equality
as comparison operator.›
theorem framing':
assumes wff : "WFF τ"
assumes modifiesclause:"τ ⊨ (X->excluding⇩S⇩e⇩t(x))->oclIsModifiedOnly()"
and oid_is_typerepr : "τ ⊨ X->forAll⇩S⇩e⇩t(a| not (x ≜ a))"
and oid_preserve: "⋀x. x ∈ ran (heap(fst τ)) ∨ x ∈ ran (heap(snd τ)) ⟹
oid_of (H x) = oid_of x"
and xy_together:
"τ ⊨ X->forAll⇩S⇩e⇩t(y | (H .allInstances()->includes⇩S⇩e⇩t(x) and H .allInstances()->includes⇩S⇩e⇩t(y)) or
(H .allInstances@pre()->includes⇩S⇩e⇩t(x) and H .allInstances@pre()->includes⇩S⇩e⇩t(y)))"
shows "τ ⊨ (x @pre P ≜ (x @post P))"
proof -
have def_X : "τ ⊨ δ X"
apply(insert oid_is_typerepr, simp add: UML_Set.OclForall_def OclValid_def split: if_split_asm)
by(simp add: bot_option_def true_def)
show ?thesis
apply(case_tac "τ ⊨ δ x", drule foundation20)
apply(rule framing[OF modifiesclause])
apply(rule OclForall_cong'[OF _ oid_is_typerepr xy_together], rename_tac y)
apply(cut_tac Set_inv_lemma'[OF def_X]) prefer 2 apply assumption
apply(rule OclNot_contrapos_nn, simp add: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def)
apply(simp add: OclValid_def, subst cp_defined, simp,
assumption)
apply(rule StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_vs_StrongEq''[THEN iffD1, OF wff _ _ oid_preserve], assumption+)
by(simp add: OclSelf_at_post_def OclSelf_at_pre_def OclValid_def StrongEq_def true_def)+
qed
subsection‹Miscellaneous›
lemma pre_post_new: "τ ⊨ (x .oclIsNew()) ⟹ ¬ (τ ⊨ υ(x @pre H1)) ∧ ¬ (τ ⊨ υ(x @post H2))"
by(simp add: OclIsNew_def OclSelf_at_pre_def OclSelf_at_post_def
OclValid_def StrongEq_def true_def false_def
bot_option_def invalid_def bot_fun_def valid_def
split: if_split_asm)
lemma pre_post_old: "τ ⊨ (x .oclIsDeleted()) ⟹ ¬ (τ ⊨ υ(x @pre H1)) ∧ ¬ (τ ⊨ υ(x @post H2))"
by(simp add: OclIsDeleted_def OclSelf_at_pre_def OclSelf_at_post_def
OclValid_def StrongEq_def true_def false_def
bot_option_def invalid_def bot_fun_def valid_def
split: if_split_asm)
lemma pre_post_absent: "τ ⊨ (x .oclIsAbsent()) ⟹ ¬ (τ ⊨ υ(x @pre H1)) ∧ ¬ (τ ⊨ υ(x @post H2))"
by(simp add: OclIsAbsent_def OclSelf_at_pre_def OclSelf_at_post_def
OclValid_def StrongEq_def true_def false_def
bot_option_def invalid_def bot_fun_def valid_def
split: if_split_asm)
lemma pre_post_maintained: "(τ ⊨ υ(x @pre H1) ∨ τ ⊨ υ(x @post H2)) ⟹ τ ⊨ (x .oclIsMaintained())"
by(simp add: OclIsMaintained_def OclSelf_at_pre_def OclSelf_at_post_def
OclValid_def StrongEq_def true_def false_def
bot_option_def invalid_def bot_fun_def valid_def
split: if_split_asm)
lemma pre_post_maintained':
"τ ⊨ (x .oclIsMaintained()) ⟹ (τ ⊨ υ(x @pre (Some o H1)) ∧ τ ⊨ υ(x @post (Some o H2)))"
by(simp add: OclIsMaintained_def OclSelf_at_pre_def OclSelf_at_post_def
OclValid_def StrongEq_def true_def false_def
bot_option_def invalid_def bot_fun_def valid_def
split: if_split_asm)
lemma framing_same_state: "(σ, σ) ⊨ (x @pre H ≜ (x @post H))"
by(simp add: OclSelf_at_pre_def OclSelf_at_post_def OclValid_def StrongEq_def)
section‹Accessors on Object›
subsection‹Definition›
definition "select_object mt incl smash deref l = smash (foldl incl mt (map deref l))
"
text‹The continuation ‹f› is usually instantiated with a smashing
function which is either the identity @{term id} or, for \inlineocl{0..1} cardinalities
of associations, the @{term OclANY}-selector which also handles the
@{term null}-cases appropriately. A standard use-case for this combinator
is for example:›
term "(select_object mtSet UML_Set.OclIncluding UML_Set.OclANY f l oid )::('𝔄, 'a::null)val"
definition "select_object⇩S⇩e⇩t = select_object mtSet UML_Set.OclIncluding id"
definition "select_object_any0⇩S⇩e⇩t f s_set = UML_Set.OclANY (select_object⇩S⇩e⇩t f s_set)"
definition "select_object_any⇩S⇩e⇩t f s_set =
(let s = select_object⇩S⇩e⇩t f s_set in
if s->size⇩S⇩e⇩t() ≜ 𝟭 then
s->any⇩S⇩e⇩t()
else
⊥
endif)"
definition "select_object⇩S⇩e⇩q = select_object mtSequence UML_Sequence.OclIncluding id"
definition "select_object_any⇩S⇩e⇩q f s_set = UML_Sequence.OclANY (select_object⇩S⇩e⇩q f s_set)"
definition "select_object⇩P⇩a⇩i⇩r f1 f2 = (λ(a,b). OclPair (f1 a) (f2 b))"
subsection‹Validity and Definedness Properties›
lemma select_fold_exec⇩S⇩e⇩q:
assumes "list_all (λf. (τ ⊨ υ f)) l"
shows "⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (foldl UML_Sequence.OclIncluding Sequence{} l τ)⌉⌉ = List.map (λf. f τ) l"
proof -
have def_fold: "⋀l. list_all (λf. τ ⊨ υ f) l ⟹
τ ⊨ (δ foldl UML_Sequence.OclIncluding Sequence{} l)"
apply(rule rev_induct[where P = "λl. list_all (λf. (τ ⊨ υ f)) l ⟶ τ ⊨ (δ foldl UML_Sequence.OclIncluding Sequence{} l)", THEN mp], simp)
by(simp add: foundation10')
show ?thesis
apply(rule rev_induct[where P = "λl. list_all (λf. (τ ⊨ υ f)) l ⟶ ⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (foldl UML_Sequence.OclIncluding Sequence{} l τ)⌉⌉ = List.map (λf. f τ) l", THEN mp], simp)
apply(simp add: mtSequence_def)
apply(subst Abs_Sequence⇩b⇩a⇩s⇩e_inverse, (simp | intro impI)+)
apply(simp add: UML_Sequence.OclIncluding_def, intro conjI impI)
apply(subst Abs_Sequence⇩b⇩a⇩s⇩e_inverse, simp, (rule disjI2)+)
apply(simp add: list_all_iff foundation18', simp)
apply(subst (asm) def_fold[simplified (no_asm) OclValid_def], simp, simp add: OclValid_def)
by (rule assms)
qed
lemma select_fold_exec⇩S⇩e⇩t:
assumes "list_all (λf. (τ ⊨ υ f)) l"
shows "⌈⌈Rep_Set⇩b⇩a⇩s⇩e (foldl UML_Set.OclIncluding Set{} l τ)⌉⌉ = set (List.map (λf. f τ) l)"
proof -
have def_fold: "⋀l. list_all (λf. τ ⊨ υ f) l ⟹
τ ⊨ (δ foldl UML_Set.OclIncluding Set{} l)"
apply(rule rev_induct[where P = "λl. list_all (λf. (τ ⊨ υ f)) l ⟶ τ ⊨ (δ foldl UML_Set.OclIncluding Set{} l)", THEN mp], simp)
by(simp add: foundation10')
show ?thesis
apply(rule rev_induct[where P = "λl. list_all (λf. (τ ⊨ υ f)) l ⟶ ⌈⌈Rep_Set⇩b⇩a⇩s⇩e (foldl UML_Set.OclIncluding Set{} l τ)⌉⌉ = set (List.map (λf. f τ) l)", THEN mp], simp)
apply(simp add: mtSet_def)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, (simp | intro impI)+)
apply(simp add: UML_Set.OclIncluding_def, intro conjI impI)
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp, (rule disjI2)+)
apply(simp add: list_all_iff foundation18', simp)
apply(subst (asm) def_fold[simplified (no_asm) OclValid_def], simp, simp add: OclValid_def)
by (rule assms)
qed
lemma fold_val_elem⇩S⇩e⇩q:
assumes "τ ⊨ υ (foldl UML_Sequence.OclIncluding Sequence{} (List.map (f p) s_set))"
shows "list_all (λx. (τ ⊨ υ (f p x))) s_set"
apply(rule rev_induct[where P = "λs_set. τ ⊨ υ foldl UML_Sequence.OclIncluding Sequence{} (List.map (f p) s_set) ⟶ list_all (λx. τ ⊨ υ f p x) s_set", THEN mp])
apply(simp, auto)
apply (metis (hide_lams, mono_tags) UML_Sequence.OclIncluding.def_valid_then_def UML_Sequence.OclIncluding.defined_args_valid foundation20)+
by(simp add: assms)
lemma fold_val_elem⇩S⇩e⇩t:
assumes "τ ⊨ υ (foldl UML_Set.OclIncluding Set{} (List.map (f p) s_set))"
shows "list_all (λx. (τ ⊨ υ (f p x))) s_set"
apply(rule rev_induct[where P = "λs_set. τ ⊨ υ foldl UML_Set.OclIncluding Set{} (List.map (f p) s_set) ⟶ list_all (λx. τ ⊨ υ f p x) s_set", THEN mp])
apply(simp, auto)
apply (metis (hide_lams, mono_tags) foundation10' foundation20)+
by(simp add: assms)
lemma select_object_any_defined⇩S⇩e⇩q:
assumes def_sel: "τ ⊨ δ (select_object_any⇩S⇩e⇩q f s_set)"
shows "s_set ≠ []"
apply(insert def_sel, case_tac s_set)
apply(simp add: select_object_any⇩S⇩e⇩q_def UML_Sequence.OclANY_def select_object⇩S⇩e⇩q_def select_object_def
defined_def OclValid_def
false_def true_def bot_fun_def bot_option_def
split: if_split_asm)
apply(simp add: mtSequence_def, subst (asm) Abs_Sequence⇩b⇩a⇩s⇩e_inverse, simp, simp)
by(simp)
lemma
assumes def_sel: "τ ⊨ δ (select_object_any0⇩S⇩e⇩t f s_set)"
shows "s_set ≠ []"
apply(insert def_sel, case_tac s_set)
apply(simp add: select_object_any0⇩S⇩e⇩t_def UML_Sequence.OclANY_def select_object⇩S⇩e⇩t_def select_object_def
defined_def OclValid_def
false_def true_def bot_fun_def bot_option_def
split: if_split_asm)
by(simp)
lemma select_object_any_defined⇩S⇩e⇩t:
assumes def_sel: "τ ⊨ δ (select_object_any⇩S⇩e⇩t f s_set)"
shows "s_set ≠ []"
apply(insert def_sel, case_tac s_set)
apply(simp add: select_object_any⇩S⇩e⇩t_def UML_Sequence.OclANY_def select_object⇩S⇩e⇩t_def select_object_def
defined_def OclValid_def
false_def true_def bot_fun_def bot_option_def
OclInt0_def OclInt1_def StrongEq_def OclIf_def null_fun_def null_option_def
split: if_split_asm)
by(simp)
lemma select_object_any_exec0⇩S⇩e⇩q:
assumes def_sel: "τ ⊨ δ (select_object_any⇩S⇩e⇩q f s_set)"
shows "τ ⊨ (select_object_any⇩S⇩e⇩q f s_set ≜ f (hd s_set))"
apply(insert def_sel[simplified foundation16],
simp add: select_object_any⇩S⇩e⇩q_def foundation22 UML_Sequence.OclANY_def split: if_split_asm)
apply(case_tac "⌈⌈Rep_Sequence⇩b⇩a⇩s⇩e (select_object⇩S⇩e⇩q f s_set τ)⌉⌉", simp add: bot_option_def, simp)
apply(simp add: select_object⇩S⇩e⇩q_def select_object_def)
apply(subst (asm) select_fold_exec⇩S⇩e⇩q)
apply(rule fold_val_elem⇩S⇩e⇩q, simp add: foundation18' invalid_def)
apply(simp)
by(drule arg_cong[where f = hd], subst (asm) hd_map, simp add: select_object_any_defined⇩S⇩e⇩q[OF def_sel], simp)
lemma select_object_any_exec⇩S⇩e⇩q:
assumes def_sel: "τ ⊨ δ (select_object_any⇩S⇩e⇩q f s_set)"
shows "∃e. List.member s_set e ∧ (τ ⊨ (select_object_any⇩S⇩e⇩q f s_set ≜ f e))"
apply(insert select_object_any_exec0⇩S⇩e⇩q[OF def_sel])
apply(rule exI[where x = "hd s_set"], simp)
apply(case_tac s_set, simp add: select_object_any_defined⇩S⇩e⇩q[OF def_sel])
by (metis list.sel member_rec(1))
lemma
assumes def_sel: "τ ⊨ δ (select_object_any0⇩S⇩e⇩t f s_set)"
shows "∃ e. List.member s_set e ∧ (τ ⊨ (select_object_any0⇩S⇩e⇩t f s_set ≜ f e))"
proof -
have list_all_map: "⋀P f l. list_all P (List.map f l) = list_all (P o f) l"
by(induct_tac l, simp_all)
fix z
show ?thesis
when "⌈⌈Rep_Set⇩b⇩a⇩s⇩e (select_object⇩S⇩e⇩t f s_set τ)⌉⌉ = z"
apply(insert that def_sel[simplified foundation16],
simp add: select_object_any0⇩S⇩e⇩t_def foundation22 UML_Set.OclANY_def null_fun_def split: if_split_asm)
apply(simp add: select_object⇩S⇩e⇩t_def select_object_def)
apply(subst (asm) select_fold_exec⇩S⇩e⇩t)
apply(rule fold_val_elem⇩S⇩e⇩t, simp add: OclValid_def)
apply(simp add: comp_def)
apply(case_tac s_set, simp, simp add: false_def true_def, simp)
proof - fix a l
show "insert (f a τ) ((λx. f x τ) ` set l) = z ⟹
∃e. List.member (a # l) e ∧ (SOME y. y ∈ z) = f e τ"
apply(rule list.induct[where P = "λl. ∀z a. insert (f a τ) ((λx. f x τ) ` set l) = z ⟶
(∃e. List.member (a # l) e ∧ ((SOME y. y ∈ z) = f e τ))", THEN spec, THEN spec, THEN mp], intro allI impI)
proof - fix x xa show "insert (f xa τ) ((λx. f x τ) ` set []) = x ⟹ ∃e. List.member [xa] e ∧ (SOME y. y ∈ x) = f e τ"
apply(rule exI[where x = xa], simp add: List.member_def)
apply(subst some_equality[where a = "f xa τ"])
apply (metis (mono_tags) insertI1)
apply (metis (mono_tags) empty_iff insert_iff)
by(simp)
apply_end(intro allI impI, simp)
fix x list xa xb
show " ∀x. ∃e. List.member (x # list) e ∧ (SOME y. y = f x τ ∨ y ∈ (λx. f x τ) ` set list) = f e τ ⟹
insert (f xb τ) (insert (f x τ) ((λx. f x τ) ` set list)) = xa ⟹
∃e. List.member (xb # x # list) e ∧ (SOME y. y ∈ xa) = f e τ"
apply(case_tac "x = xb", simp)
apply(erule allE[where x = xb])
apply(erule exE)
proof - fix e show "insert (f xb τ) ((λx. f x τ) ` set list) = xa ⟹
x = xb ⟹
List.member (xb # list) e ∧ (SOME y. y = f xb τ ∨ y ∈ (λx. f x τ) ` set list) = f e τ ⟹
∃e. List.member (xb # xb # list) e ∧ (SOME y. y ∈ xa) = f e τ"
apply(rule exI[where x = e], auto)
by (metis member_rec(1))
apply_end(case_tac "List.member list x")
apply_end(erule allE[where x = xb])
apply_end(erule exE)
fix e
let ?P = "λy. y = f xb τ ∨ y ∈ (λx. f x τ) ` set list"
show "insert (f xb τ) (insert (f x τ) ((λx. f x τ) ` set list)) = xa ⟹
x ≠ xb ⟹
List.member list x ⟹
List.member (xb # list) e ∧ (SOME y. y = f xb τ ∨ y ∈ (λx. f x τ) ` set list) = f e τ ⟹
∃e. List.member (xb # x # list) e ∧ (SOME y. y ∈ xa) = f e τ"
apply(rule exI[where x = e], auto)
apply (metis member_rec(1))
apply(subgoal_tac "?P (f e τ)")
prefer 2
apply(case_tac "xb = e", simp)
apply (metis (mono_tags) image_eqI in_set_member member_rec(1))
apply(rule someI2[where a = "f e τ"])
apply(erule disjE, simp)+
apply(rule disjI2)+ apply(simp)
oops
lemma select_object_any_exec⇩S⇩e⇩t:
assumes def_sel: "τ ⊨ δ (select_object_any⇩S⇩e⇩t f s_set)"
shows "∃ e. List.member s_set e ∧ (τ ⊨ (select_object_any⇩S⇩e⇩t f s_set ≜ f e))"
proof -
have card_singl: "⋀A a. finite A ⟹ card (insert a A) = 1 ⟹ A ⊆ {a}"
by (auto, metis Suc_inject card_Suc_eq card_eq_0_iff insert_absorb insert_not_empty singleton_iff)
have list_same: "⋀f s_set z' x. f ` set s_set = {z'} ⟹ List.member s_set x ⟹ f x = z'"
by (metis (full_types) empty_iff imageI in_set_member insert_iff)
fix z
show ?thesis
when "⌈⌈Rep_Set⇩b⇩a⇩s⇩e (select_object⇩S⇩e⇩t f s_set τ)⌉⌉ = z"
apply(insert that def_sel[simplified foundation16],
simp add: select_object_any⇩S⇩e⇩t_def foundation22
Let_def null_fun_def bot_fun_def OclIf_def
split: if_split_asm)
apply(simp add: StrongEq_def OclInt1_def true_def UML_Set.OclSize_def
bot_option_def UML_Set.OclANY_def null_fun_def
split: if_split_asm)
apply(subgoal_tac "∃z'. z = {z'}")
prefer 2
apply(rule finite.cases[where a = z], simp, simp, simp)
apply(rule card_singl, simp, simp)
apply(erule exE, clarsimp)
apply(simp add: select_object⇩S⇩e⇩t_def select_object_def)
apply(subst (asm) select_fold_exec⇩S⇩e⇩t)
apply(rule fold_val_elem⇩S⇩e⇩t, simp add: OclValid_def true_def)
apply(simp add: comp_def)
apply(case_tac s_set, simp)
proof - fix z' a list show "(λx. f x τ) ` set s_set = {z'} ⟹ s_set = a # list ⟹ ∃e. List.member s_set e ∧ z' = f e τ"
apply(drule list_same[where x1 = a])
apply (metis member_rec(1))
by (metis (hide_lams, mono_tags) ListMem_iff elem in_set_member)
qed
qed blast+
end
Theory UML_Contracts
theory UML_Contracts
imports UML_State
begin
text‹Modeling of an operation contract for an operation with 2 arguments,
(so depending on three parameters if one takes "self" into account).›
locale contract_scheme =
fixes f_υ
fixes f_lam
fixes f :: "('𝔄,'α0::null)val ⇒
'b ⇒
('𝔄,'res::null)val"
fixes PRE
fixes POST
assumes def_scheme': "f self x ≡ (λ τ. SOME res. let res = λ _. res in
if (τ ⊨ (δ self)) ∧ f_υ x τ
then (τ ⊨ PRE self x) ∧
(τ ⊨ POST self x res)
else τ ⊨ res ≜ invalid)"
assumes all_post': "∀ σ σ' σ''. ((σ,σ') ⊨ PRE self x) = ((σ,σ'') ⊨ PRE self x)"
assumes cp⇩P⇩R⇩E': "PRE (self) x τ = PRE (λ _. self τ) (f_lam x τ) τ "
assumes cp⇩P⇩O⇩S⇩T':"POST (self) x (res) τ = POST (λ _. self τ) (f_lam x τ) (λ _. res τ) τ"
assumes f_υ_val: "⋀a1. f_υ (f_lam a1 τ) τ = f_υ a1 τ"
begin
lemma strict0 [simp]: "f invalid X = invalid"
by(rule ext, rename_tac "τ", simp add: def_scheme' StrongEq_def OclValid_def false_def true_def)
lemma nullstrict0[simp]: "f null X = invalid"
by(rule ext, rename_tac "τ", simp add: def_scheme' StrongEq_def OclValid_def false_def true_def)
lemma cp0 : "f self a1 τ = f (λ _. self τ) (f_lam a1 τ) τ"
proof -
have A: "(τ ⊨ δ (λ_. self τ)) = (τ ⊨ δ self)" by(simp add: OclValid_def cp_defined[symmetric])
have B: "f_υ (f_lam a1 τ) τ = f_υ a1 τ" by (rule f_υ_val)
have D: "(τ ⊨ PRE (λ_. self τ) (f_lam a1 τ)) = ( τ ⊨ PRE self a1 )"
by(simp add: OclValid_def cp⇩P⇩R⇩E'[symmetric])
show ?thesis
apply(auto simp: def_scheme' A B D)
apply(simp add: OclValid_def)
by(subst cp⇩P⇩O⇩S⇩T', simp)
qed
theorem unfold' :
assumes context_ok: "cp E"
and args_def_or_valid: "(τ ⊨ δ self) ∧ f_υ a1 τ"
and pre_satisfied: "τ ⊨ PRE self a1"
and post_satisfiable: " ∃res. (τ ⊨ POST self a1 (λ _. res))"
and sat_for_sols_post: "(⋀res. τ ⊨ POST self a1 (λ _. res) ⟹ τ ⊨ E (λ _. res))"
shows "τ ⊨ E(f self a1)"
proof -
have cp0: "⋀ X τ. E X τ = E (λ_. X τ) τ" by(insert context_ok[simplified cp_def], auto)
show ?thesis
apply(simp add: OclValid_def, subst cp0, fold OclValid_def)
apply(simp add:def_scheme' args_def_or_valid pre_satisfied)
apply(insert post_satisfiable, elim exE)
apply(rule Hilbert_Choice.someI2, assumption)
by(rule sat_for_sols_post, simp)
qed
lemma unfold2' :
assumes context_ok: "cp E"
and args_def_or_valid: "(τ ⊨ δ self) ∧ (f_υ a1 τ)"
and pre_satisfied: "τ ⊨ PRE self a1"
and postsplit_satisfied: "τ ⊨ POST' self a1"
and post_decomposable : "⋀ res. (POST self a1 res) =
((POST' self a1) and (res ≜ (BODY self a1)))"
shows "(τ ⊨ E(f self a1)) = (τ ⊨ E(BODY self a1))"
proof -
have cp0: "⋀ X τ. E X τ = E (λ_. X τ) τ" by(insert context_ok[simplified cp_def], auto)
show ?thesis
apply(simp add: OclValid_def, subst cp0, fold OclValid_def)
apply(simp add:def_scheme' args_def_or_valid pre_satisfied
post_decomposable postsplit_satisfied foundation10')
apply(subst some_equality)
apply(simp add: OclValid_def StrongEq_def true_def)+
by(subst (2) cp0, rule refl)
qed
end
locale contract0 =
fixes f :: "('𝔄,'α0::null)val ⇒
('𝔄,'res::null)val"
fixes PRE
fixes POST
assumes def_scheme: "f self ≡ (λ τ. SOME res. let res = λ _. res in
if (τ ⊨ (δ self))
then (τ ⊨ PRE self) ∧
(τ ⊨ POST self res)
else τ ⊨ res ≜ invalid)"
assumes all_post: "∀ σ σ' σ''. ((σ,σ') ⊨ PRE self) = ((σ,σ'') ⊨ PRE self)"
assumes cp⇩P⇩R⇩E: "PRE (self) τ = PRE (λ _. self τ) τ "
assumes cp⇩P⇩O⇩S⇩T:"POST (self) (res) τ = POST (λ _. self τ) (λ _. res τ) τ"
sublocale contract0 < contract_scheme "λ_ _. True" "λx _. x" "λx _. f x" "λx _. PRE x" "λx _. POST x"
apply(unfold_locales)
apply(simp add: def_scheme, rule all_post, rule cp⇩P⇩R⇩E, rule cp⇩P⇩O⇩S⇩T)
by simp
context contract0
begin
lemma cp_pre: "cp self' ⟹ cp (λX. PRE (self' X) )"
by(rule_tac f=PRE in cpI1, auto intro: cp⇩P⇩R⇩E)
lemma cp_post: "cp self' ⟹ cp res' ⟹ cp (λX. POST (self' X) (res' X))"
by(rule_tac f=POST in cpI2, auto intro: cp⇩P⇩O⇩S⇩T)
lemma cp [simp]: "cp self' ⟹ cp res' ⟹ cp (λX. f (self' X) )"
by(rule_tac f=f in cpI1, auto intro:cp0)
lemmas unfold = unfold'[simplified]
lemma unfold2 :
assumes "cp E"
and "(τ ⊨ δ self)"
and "τ ⊨ PRE self"
and "τ ⊨ POST' self"
and "⋀ res. (POST self res) =
((POST' self) and (res ≜ (BODY self)))"
shows "(τ ⊨ E(f self)) = (τ ⊨ E(BODY self))"
apply(rule unfold2'[simplified])
by((rule assms)+)
end
locale contract1 =
fixes f :: "('𝔄,'α0::null)val ⇒
('𝔄,'α1::null)val ⇒
('𝔄,'res::null)val"
fixes PRE
fixes POST
assumes def_scheme: "f self a1 ≡
(λ τ. SOME res. let res = λ _. res in
if (τ ⊨ (δ self)) ∧ (τ ⊨ υ a1)
then (τ ⊨ PRE self a1) ∧
(τ ⊨ POST self a1 res)
else τ ⊨ res ≜ invalid) "
assumes all_post: "∀ σ σ' σ''. ((σ,σ') ⊨ PRE self a1) = ((σ,σ'') ⊨ PRE self a1)"
assumes cp⇩P⇩R⇩E: "PRE (self) (a1) τ = PRE (λ _. self τ) (λ _. a1 τ) τ "
assumes cp⇩P⇩O⇩S⇩T:"POST (self) (a1) (res) τ = POST (λ _. self τ)(λ _. a1 τ) (λ _. res τ) τ"
sublocale contract1 < contract_scheme "λa1 τ. (τ ⊨ υ a1)" "λa1 τ. (λ _. a1 τ)"
apply(unfold_locales)
apply(rule def_scheme, rule all_post, rule cp⇩P⇩R⇩E, rule cp⇩P⇩O⇩S⇩T)
by(simp add: OclValid_def cp_valid[symmetric])
context contract1
begin
lemma strict1[simp]: "f self invalid = invalid"
by(rule ext, rename_tac "τ", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
lemma defined_mono : "τ ⊨υ(f Y Z) ⟹ (τ ⊨δ Y) ∧ (τ ⊨υ Z)"
by(auto simp: valid_def bot_fun_def invalid_def
def_scheme StrongEq_def OclValid_def false_def true_def
split: if_split_asm)
lemma cp_pre: "cp self' ⟹ cp a1' ⟹ cp (λX. PRE (self' X) (a1' X) )"
by(rule_tac f=PRE in cpI2, auto intro: cp⇩P⇩R⇩E)
lemma cp_post: "cp self' ⟹ cp a1' ⟹ cp res'
⟹ cp (λX. POST (self' X) (a1' X) (res' X))"
by(rule_tac f=POST in cpI3, auto intro: cp⇩P⇩O⇩S⇩T)
lemma cp [simp]: "cp self' ⟹ cp a1' ⟹ cp res' ⟹ cp (λX. f (self' X) (a1' X))"
by(rule_tac f=f in cpI2, auto intro:cp0)
lemmas unfold = unfold'
lemmas unfold2 = unfold2'
end
locale contract2 =
fixes f :: "('𝔄,'α0::null)val ⇒
('𝔄,'α1::null)val ⇒ ('𝔄,'α2::null)val ⇒
('𝔄,'res::null)val"
fixes PRE
fixes POST
assumes def_scheme: "f self a1 a2 ≡
(λ τ. SOME res. let res = λ _. res in
if (τ ⊨ (δ self)) ∧ (τ ⊨ υ a1) ∧ (τ ⊨ υ a2)
then (τ ⊨ PRE self a1 a2) ∧
(τ ⊨ POST self a1 a2 res)
else τ ⊨ res ≜ invalid) "
assumes all_post: "∀ σ σ' σ''. ((σ,σ') ⊨ PRE self a1 a2) = ((σ,σ'') ⊨ PRE self a1 a2)"
assumes cp⇩P⇩R⇩E: "PRE (self) (a1) (a2) τ = PRE (λ _. self τ) (λ _. a1 τ) (λ _. a2 τ) τ "
assumes cp⇩P⇩O⇩S⇩T:"⋀res. POST (self) (a1) (a2) (res) τ =
POST (λ _. self τ)(λ _. a1 τ)(λ _. a2 τ) (λ _. res τ) τ"
sublocale contract2 < contract_scheme "λ(a1,a2) τ. (τ ⊨ υ a1) ∧ (τ ⊨ υ a2)"
"λ(a1,a2) τ. (λ _.a1 τ, λ _.a2 τ)"
"(λx (a,b). f x a b)"
"(λx (a,b). PRE x a b)"
"(λx (a,b). POST x a b)"
apply(unfold_locales)
apply(auto simp add: def_scheme)
apply (metis all_post, metis all_post)
apply(subst cp⇩P⇩R⇩E, simp)
apply(subst cp⇩P⇩O⇩S⇩T, simp)
by(simp_all add: OclValid_def cp_valid[symmetric])
context contract2
begin
lemma strict0'[simp] : "f invalid X Y = invalid"
by(insert strict0[of "(X,Y)"], simp)
lemma nullstrict0'[simp]: "f null X Y = invalid"
by(insert nullstrict0[of "(X,Y)"], simp)
lemma strict1[simp]: "f self invalid Y = invalid"
by(rule ext, rename_tac "τ", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
lemma strict2[simp]: "f self X invalid = invalid"
by(rule ext, rename_tac "τ", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
lemma defined_mono : "τ ⊨υ(f X Y Z) ⟹ (τ ⊨δ X) ∧ (τ ⊨υ Y) ∧ (τ ⊨υ Z)"
by(auto simp: valid_def bot_fun_def invalid_def
def_scheme StrongEq_def OclValid_def false_def true_def
split: if_split_asm)
lemma cp_pre: "cp self' ⟹ cp a1' ⟹ cp a2' ⟹ cp (λX. PRE (self' X) (a1' X) (a2' X) )"
by(rule_tac f=PRE in cpI3, auto intro: cp⇩P⇩R⇩E)
lemma cp_post: "cp self' ⟹ cp a1' ⟹ cp a2' ⟹ cp res'
⟹ cp (λX. POST (self' X) (a1' X) (a2' X) (res' X))"
by(rule_tac f=POST in cpI4, auto intro: cp⇩P⇩O⇩S⇩T)
lemma cp0' : "f self a1 a2 τ = f (λ _. self τ) (λ _. a1 τ) (λ _. a2 τ) τ"
by (rule cp0[of _ "(a1,a2)", simplified])
lemma cp [simp]: "cp self' ⟹ cp a1' ⟹ cp a2' ⟹ cp res'
⟹ cp (λX. f (self' X) (a1' X) (a2' X))"
by(rule_tac f=f in cpI3, auto intro:cp0')
theorem unfold :
assumes "cp E"
and "(τ ⊨ δ self) ∧ (τ ⊨ υ a1) ∧ (τ ⊨ υ a2)"
and "τ ⊨ PRE self a1 a2"
and " ∃res. (τ ⊨ POST self a1 a2 (λ _. res))"
and "(⋀res. τ ⊨ POST self a1 a2 (λ _. res) ⟹ τ ⊨ E (λ _. res))"
shows "τ ⊨ E(f self a1 a2)"
apply(rule unfold'[of _ _ _ "(a1, a2)", simplified])
by((rule assms)+)
lemma unfold2 :
assumes "cp E"
and "(τ ⊨ δ self) ∧ (τ ⊨ υ a1) ∧ (τ ⊨ υ a2)"
and "τ ⊨ PRE self a1 a2"
and "τ ⊨ POST' self a1 a2"
and "⋀ res. (POST self a1 a2 res) =
((POST' self a1 a2) and (res ≜ (BODY self a1 a2)))"
shows "(τ ⊨ E(f self a1 a2)) = (τ ⊨ E(BODY self a1 a2))"
apply(rule unfold2'[of _ _ _ "(a1, a2)", simplified])
by((rule assms)+)
end
locale contract3 =
fixes f :: "('𝔄,'α0::null)val ⇒
('𝔄,'α1::null)val ⇒
('𝔄,'α2::null)val ⇒
('𝔄,'α3::null)val ⇒
('𝔄,'res::null)val"
fixes PRE
fixes POST
assumes def_scheme: "f self a1 a2 a3 ≡
(λ τ. SOME res. let res = λ _. res in
if (τ ⊨ (δ self)) ∧ (τ ⊨ υ a1) ∧ (τ ⊨ υ a2) ∧ (τ ⊨ υ a3)
then (τ ⊨ PRE self a1 a2 a3) ∧
(τ ⊨ POST self a1 a2 a3 res)
else τ ⊨ res ≜ invalid) "
assumes all_post: "∀ σ σ' σ''. ((σ,σ') ⊨ PRE self a1 a2 a3) = ((σ,σ'') ⊨ PRE self a1 a2 a3)"
assumes cp⇩P⇩R⇩E: "PRE (self) (a1) (a2) (a3) τ = PRE (λ _. self τ) (λ _. a1 τ) (λ _. a2 τ) (λ _. a3 τ) τ "
assumes cp⇩P⇩O⇩S⇩T:"⋀res. POST (self) (a1) (a2) (a3) (res) τ =
POST (λ _. self τ)(λ _. a1 τ)(λ _. a2 τ)(λ _. a3 τ) (λ _. res τ) τ"
sublocale contract3 < contract_scheme "λ(a1,a2,a3) τ. (τ ⊨ υ a1) ∧ (τ ⊨ υ a2)∧ (τ ⊨ υ a3)"
"λ(a1,a2,a3) τ. (λ _.a1 τ, λ _.a2 τ, λ _.a3 τ)"
"(λx (a,b,c). f x a b c)"
"(λx (a,b,c). PRE x a b c)"
"(λx (a,b,c). POST x a b c)"
apply(unfold_locales)
apply(auto simp add: def_scheme)
apply (metis all_post, metis all_post)
apply(subst cp⇩P⇩R⇩E, simp)
apply(subst cp⇩P⇩O⇩S⇩T, simp)
by(simp_all add: OclValid_def cp_valid[symmetric])
context contract3
begin
lemma strict0'[simp] : "f invalid X Y Z = invalid"
by(rule ext, rename_tac "τ", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
lemma nullstrict0'[simp]: "f null X Y Z = invalid"
by(rule ext, rename_tac "τ", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
lemma strict1[simp]: "f self invalid Y Z = invalid"
by(rule ext, rename_tac "τ", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
lemma strict2[simp]: "f self X invalid Z = invalid"
by(rule ext, rename_tac "τ", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
lemma defined_mono : "τ ⊨υ(f W X Y Z) ⟹ (τ ⊨δ W) ∧ (τ ⊨υ X) ∧ (τ ⊨υ Y) ∧ (τ ⊨υ Z)"
by(auto simp: valid_def bot_fun_def invalid_def
def_scheme StrongEq_def OclValid_def false_def true_def
split: if_split_asm)
lemma cp_pre: "cp self' ⟹ cp a1' ⟹ cp a2'⟹ cp a3'
⟹ cp (λX. PRE (self' X) (a1' X) (a2' X) (a3' X) )"
by(rule_tac f=PRE in cpI4, auto intro: cp⇩P⇩R⇩E)
lemma cp_post: "cp self' ⟹ cp a1' ⟹ cp a2' ⟹ cp a3' ⟹ cp res'
⟹ cp (λX. POST (self' X) (a1' X) (a2' X) (a3' X) (res' X))"
by(rule_tac f=POST in cpI5, auto intro: cp⇩P⇩O⇩S⇩T)
lemma cp0' : "f self a1 a2 a3 τ = f (λ _. self τ) (λ _. a1 τ) (λ _. a2 τ) (λ _. a3 τ) τ"
by (rule cp0[of _ "(a1,a2,a3)", simplified])
lemma cp [simp]: "cp self' ⟹ cp a1' ⟹ cp a2' ⟹ cp a3' ⟹ cp res'
⟹ cp (λX. f (self' X) (a1' X) (a2' X) (a3' X))"
by(rule_tac f=f in cpI4, auto intro:cp0')
theorem unfold :
assumes "cp E"
and "(τ ⊨ δ self) ∧ (τ ⊨ υ a1) ∧ (τ ⊨ υ a2) ∧ (τ ⊨ υ a3)"
and "τ ⊨ PRE self a1 a2 a3"
and " ∃res. (τ ⊨ POST self a1 a2 a3 (λ _. res))"
and "(⋀res. τ ⊨ POST self a1 a2 a3 (λ _. res) ⟹ τ ⊨ E (λ _. res))"
shows "τ ⊨ E(f self a1 a2 a3)"
apply(rule unfold'[of _ _ _ "(a1, a2, a3)", simplified])
by((rule assms)+)
lemma unfold2 :
assumes "cp E"
and "(τ ⊨ δ self) ∧ (τ ⊨ υ a1) ∧ (τ ⊨ υ a2) ∧ (τ ⊨ υ a3)"
and "τ ⊨ PRE self a1 a2 a3"
and "τ ⊨ POST' self a1 a2 a3"
and "⋀ res. (POST self a1 a2 a3 res) =
((POST' self a1 a2 a3) and (res ≜ (BODY self a1 a2 a3)))"
shows "(τ ⊨ E(f self a1 a2 a3)) = (τ ⊨ E(BODY self a1 a2 a3))"
apply(rule unfold2'[of _ _ _ "(a1, a2, a3)", simplified])
by((rule assms)+)
end
end
Theory UML_Main
theory UML_Main
imports UML_Contracts UML_Tools
begin
end
Theory Analysis_UML
chapter‹Example: The Employee Analysis Model›
theory
Analysis_UML
imports
"../../../UML_Main"
begin
text ‹\label{ex:employee-analysis:uml}›
section‹Introduction›
text‹
For certain concepts like classes and class-types, only a generic
definition for its resulting semantics can be given. Generic means,
there is a function outside HOL that ``compiles'' a concrete,
closed-world class diagram into a ``theory'' of this data model,
consisting of a bunch of definitions for classes, accessors, method,
casts, and tests for actual types, as well as proofs for the
fundamental properties of these operations in this concrete data
model.›
text‹Such generic function or ``compiler'' can be implemented in
Isabelle on the ML level. This has been done, for a semantics
following the open-world assumption, for UML 2.0
in~\cite{brucker.ea:extensible:2008-b, brucker:interactive:2007}. In
this paper, we follow another approach for UML 2.4: we define the
concepts of the compilation informally, and present a concrete
example which is verified in Isabelle/HOL.›
subsection‹Outlining the Example›
text‹We are presenting here an ``analysis-model'' of the (slightly
modified) example Figure 7.3, page 20 of
the OCL standard~\cite{omg:ocl:2012}.
Here, analysis model means that associations
were really represented as relation on objects on the state---as is
intended by the standard---rather by pointers between objects as is
done in our ``design model''
\isatagafp
(see \autoref{ex:employee-design:uml}).
\endisatagafp
\isatagannexa
(see \url{http://isa-afp.org/entries/Featherweight_OCL.shtml}).
\endisatagannexa
To be precise, this theory contains the formalization of the data-part
covered by the UML class model (see \autoref{fig:person-ana}):›
text‹
\begin{figure}
\centering\scalebox{.3}{\includegraphics{figures/person.png}}%
\caption{A simple UML class model drawn from Figure 7.3,
page 20 of~\cite{omg:ocl:2012}. \label{fig:person-ana}}
\end{figure}
›
text‹This means that the association (attached to the association class
\inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented
by the attribute \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the OCL part
captured by the subsequent theory).
›
section‹Example Data-Universe and its Infrastructure›
text‹Ideally, the following is generated automatically from a UML class model.›
text‹Our data universe consists in the concrete class diagram just of node's,
and implicitly of the class object. Each class implies the existence of a class
type defined for the corresponding object representations as follows:›
datatype type⇩P⇩e⇩r⇩s⇩o⇩n = mk⇩P⇩e⇩r⇩s⇩o⇩n oid
"int option"
datatype type⇩O⇩c⇩l⇩A⇩n⇩y = mk⇩O⇩c⇩l⇩A⇩n⇩y oid
"(int option) option"
text‹Now, we construct a concrete ``universe of OclAny types'' by injection into a
sum type containing the class types. This type of OclAny will be used as instance
for all respective type-variables.›
datatype 𝔄 = in⇩P⇩e⇩r⇩s⇩o⇩n type⇩P⇩e⇩r⇩s⇩o⇩n | in⇩O⇩c⇩l⇩A⇩n⇩y type⇩O⇩c⇩l⇩A⇩n⇩y
text‹Having fixed the object universe, we can introduce type synonyms that exactly correspond
to OCL types. Again, we exploit that our representation of OCL is a ``shallow embedding'' with a
one-to-one correspondance of OCL-types to types of the meta-language HOL.›
type_synonym Boolean = " 𝔄 Boolean"
type_synonym Integer = " 𝔄 Integer"
type_synonym Void = " 𝔄 Void"
type_synonym OclAny = "(𝔄, type⇩O⇩c⇩l⇩A⇩n⇩y option option) val"
type_synonym Person = "(𝔄, type⇩P⇩e⇩r⇩s⇩o⇩n option option) val"
type_synonym Set_Integer = "(𝔄, int option option) Set"
type_synonym Set_Person = "(𝔄, type⇩P⇩e⇩r⇩s⇩o⇩n option option) Set"
text‹Just a little check:›
typ "Boolean"
text‹To reuse key-elements of the library like referential equality, we have
to show that the object universe belongs to the type class ``oclany,'' \ie,
each class type has to provide a function @{term oid_of} yielding the object id (oid) of the object.›
instantiation type⇩P⇩e⇩r⇩s⇩o⇩n :: object
begin
definition oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def: "oid_of x = (case x of mk⇩P⇩e⇩r⇩s⇩o⇩n oid _ ⇒ oid)"
instance ..
end
instantiation type⇩O⇩c⇩l⇩A⇩n⇩y :: object
begin
definition oid_of_type⇩O⇩c⇩l⇩A⇩n⇩y_def: "oid_of x = (case x of mk⇩O⇩c⇩l⇩A⇩n⇩y oid _ ⇒ oid)"
instance ..
end
instantiation 𝔄 :: object
begin
definition oid_of_𝔄_def: "oid_of x = (case x of
in⇩P⇩e⇩r⇩s⇩o⇩n person ⇒ oid_of person
| in⇩O⇩c⇩l⇩A⇩n⇩y oclany ⇒ oid_of oclany)"
instance ..
end
section‹Instantiation of the Generic Strict Equality›
text‹We instantiate the referential equality
on ‹Person› and ‹OclAny››
overloading StrictRefEq ≡ "StrictRefEq :: [Person,Person] ⇒ Boolean"
begin
definition StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n : "(x::Person) ≐ y ≡ StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x y"
end
overloading StrictRefEq ≡ "StrictRefEq :: [OclAny,OclAny] ⇒ Boolean"
begin
definition StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩O⇩c⇩l⇩A⇩n⇩y : "(x::OclAny) ≐ y ≡ StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x y"
end
lemmas cps23 =
cp_StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t[of "x::Person" "y::Person" "τ",
simplified StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n[symmetric]]
cp_intro(9) [of "P::Person ⇒Person""Q::Person ⇒Person",
simplified StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n[symmetric] ]
StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def [of "x::Person" "y::Person",
simplified StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n[symmetric]]
StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_defargs [of _ "x::Person" "y::Person",
simplified StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n[symmetric]]
StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_strict1
[of "x::Person",
simplified StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n[symmetric]]
StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_strict2
[of "x::Person",
simplified StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n[symmetric]]
for x y τ P Q
text‹For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)},
a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form
\inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator.
›
text‹Thus, since we have two class-types in our concrete class hierarchy, we have
two operations to declare and to provide two overloading definitions for the two static types.
›
section‹OclAsType›
subsection‹Definition›
consts OclAsType⇩O⇩c⇩l⇩A⇩n⇩y :: "'α ⇒ OclAny" ("(_) .oclAsType'(OclAny')")
consts OclAsType⇩P⇩e⇩r⇩s⇩o⇩n :: "'α ⇒ Person" ("(_) .oclAsType'(Person')")
definition "OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄 = (λu. ⌊case u of in⇩O⇩c⇩l⇩A⇩n⇩y a ⇒ a
| in⇩P⇩e⇩r⇩s⇩o⇩n (mk⇩P⇩e⇩r⇩s⇩o⇩n oid a) ⇒ mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊a⌋⌋)"
lemma OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄_some: "OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄 x ≠ None"
by(simp add: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄_def)
overloading OclAsType⇩O⇩c⇩l⇩A⇩n⇩y ≡ "OclAsType⇩O⇩c⇩l⇩A⇩n⇩y :: OclAny ⇒ OclAny"
begin
definition OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny:
"(X::OclAny) .oclAsType(OclAny) ≡ X"
end
overloading OclAsType⇩O⇩c⇩l⇩A⇩n⇩y ≡ "OclAsType⇩O⇩c⇩l⇩A⇩n⇩y :: Person ⇒ OclAny"
begin
definition OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person:
"(X::Person) .oclAsType(OclAny) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| ⌊⊥⌋ ⇒ null τ
| ⌊⌊mk⇩P⇩e⇩r⇩s⇩o⇩n oid a ⌋⌋ ⇒ ⌊⌊ (mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊a⌋) ⌋⌋)"
end
definition "OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄 =
(λu. case u of in⇩P⇩e⇩r⇩s⇩o⇩n p ⇒ ⌊p⌋
| in⇩O⇩c⇩l⇩A⇩n⇩y (mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊a⌋) ⇒ ⌊mk⇩P⇩e⇩r⇩s⇩o⇩n oid a⌋
| _ ⇒ None)"
overloading OclAsType⇩P⇩e⇩r⇩s⇩o⇩n ≡ "OclAsType⇩P⇩e⇩r⇩s⇩o⇩n :: OclAny ⇒ Person"
begin
definition OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny:
"(X::OclAny) .oclAsType(Person) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| ⌊⊥⌋ ⇒ null τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⊥ ⌋⌋ ⇒ invalid τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊a⌋ ⌋⌋ ⇒ ⌊⌊mk⇩P⇩e⇩r⇩s⇩o⇩n oid a⌋⌋)"
end
overloading OclAsType⇩P⇩e⇩r⇩s⇩o⇩n ≡ "OclAsType⇩P⇩e⇩r⇩s⇩o⇩n :: Person ⇒ Person"
begin
definition OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person:
"(X::Person) .oclAsType(Person) ≡ X "
end
text_raw‹\isatagafp›
lemmas [simp] =
OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny
OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person
subsection‹Context Passing›
lemma cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person_Person: "cp P ⟹ cp(λX. (P (X::Person)::Person) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_OclAny: "cp P ⟹ cp(λX. (P (X::OclAny)::OclAny) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person_Person: "cp P ⟹ cp(λX. (P (X::Person)::Person) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemma cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_OclAny: "cp P ⟹ cp(λX. (P (X::OclAny)::OclAny) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person_OclAny: "cp P ⟹ cp(λX. (P (X::Person)::OclAny) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_Person: "cp P ⟹ cp(λX. (P (X::OclAny)::Person) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person_OclAny: "cp P ⟹ cp(λX. (P (X::Person)::OclAny) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_Person: "cp P ⟹ cp(λX. (P (X::OclAny)::Person) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemmas [simp] =
cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person_Person
cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_OclAny
cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person_Person
cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_OclAny
cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person_OclAny
cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_Person
cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person_OclAny
cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_Person
text_raw‹\endisatagafp›
subsection‹Execution with Invalid or Null as Argument›
lemma OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_strict : "(invalid::OclAny) .oclAsType(OclAny) = invalid" by(simp)
lemma OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_nullstrict : "(null::OclAny) .oclAsType(OclAny) = null" by(simp)
lemma OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person_strict[simp] : "(invalid::Person) .oclAsType(OclAny) = invalid"
by(rule ext, simp add: bot_option_def invalid_def OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person_nullstrict[simp] : "(null::Person) .oclAsType(OclAny) = null"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_strict[simp] : "(invalid::OclAny) .oclAsType(Person) = invalid"
by(rule ext, simp add: bot_option_def invalid_def OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_nullstrict[simp] : "(null::OclAny) .oclAsType(Person) = null"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person_strict : "(invalid::Person) .oclAsType(Person) = invalid" by(simp)
lemma OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person_nullstrict : "(null::Person) .oclAsType(Person) = null" by(simp)
section‹OclIsTypeOf›
subsection‹Definition›
consts OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y :: "'α ⇒ Boolean" ("(_).oclIsTypeOf'(OclAny')")
consts OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n :: "'α ⇒ Boolean" ("(_).oclIsTypeOf'(Person')")
overloading OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y ≡ "OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y :: OclAny ⇒ Boolean"
begin
definition OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny:
"(X::OclAny) .oclIsTypeOf(OclAny) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| ⌊⊥⌋ ⇒ true τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⊥ ⌋⌋ ⇒ true τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊_⌋ ⌋⌋ ⇒ false τ)"
end
lemma OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny':
"(X::OclAny) .oclIsTypeOf(OclAny) =
(λ τ. if τ ⊨ υ X then (case X τ of
⌊⊥⌋ ⇒ true τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⊥ ⌋⌋ ⇒ true τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊_⌋ ⌋⌋ ⇒ false τ)
else invalid τ)"
apply(rule ext, simp add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
by(case_tac "τ ⊨ υ X", auto simp: foundation18' bot_option_def)
interpretation OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny :
profile_mono_schemeV
"OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y::OclAny ⇒ Boolean"
"λ X. (case X of
⌊None⌋ ⇒ ⌊⌊True⌋⌋
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid None ⌋⌋ ⇒ ⌊⌊True⌋⌋
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊_⌋ ⌋⌋ ⇒ ⌊⌊False⌋⌋)"
apply(unfold_locales, simp add: atomize_eq, rule ext)
by(auto simp: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny' OclValid_def true_def false_def
split: option.split type⇩O⇩c⇩l⇩A⇩n⇩y.split)
overloading OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y ≡ "OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y :: Person ⇒ Boolean"
begin
definition OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person:
"(X::Person) .oclIsTypeOf(OclAny) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| ⌊⊥⌋ ⇒ true τ
| ⌊⌊ _ ⌋⌋ ⇒ false τ) "
end
overloading OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n ≡ "OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n :: OclAny ⇒ Boolean"
begin
definition OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny:
"(X::OclAny) .oclIsTypeOf(Person) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| ⌊⊥⌋ ⇒ true τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⊥ ⌋⌋ ⇒ false τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊_⌋ ⌋⌋ ⇒ true τ)"
end
overloading OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n ≡ "OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n :: Person ⇒ Boolean"
begin
definition OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person:
"(X::Person) .oclIsTypeOf(Person) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| _ ⇒ true τ)"
end
text_raw‹\isatagafp›
subsection‹Context Passing›
lemma cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_Person: "cp P ⟹ cp(λX.(P(X::Person)::Person).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_OclAny: "cp P ⟹ cp(λX.(P(X::OclAny)::OclAny).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_Person: "cp P ⟹ cp(λX.(P(X::Person)::Person).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemma cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_OclAny: "cp P ⟹ cp(λX.(P(X::OclAny)::OclAny).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_OclAny: "cp P ⟹ cp(λX.(P(X::Person)::OclAny).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_Person: "cp P ⟹ cp(λX.(P(X::OclAny)::Person).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_OclAny: "cp P ⟹ cp(λX.(P(X::Person)::OclAny).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_Person: "cp P ⟹ cp(λX.(P(X::OclAny)::Person).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemmas [simp] =
cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_Person
cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_OclAny
cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_Person
cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_OclAny
cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_OclAny
cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_Person
cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_OclAny
cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_Person
text_raw‹\endisatagafp›
subsection‹Execution with Invalid or Null as Argument›
lemma OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_strict1[simp]:
"(invalid::OclAny) .oclIsTypeOf(OclAny) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_strict2[simp]:
"(null::OclAny) .oclIsTypeOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_strict1[simp]:
"(invalid::Person) .oclIsTypeOf(OclAny) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_strict2[simp]:
"(null::Person) .oclIsTypeOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_strict1[simp]:
"(invalid::OclAny) .oclIsTypeOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_strict2[simp]:
"(null::OclAny) .oclIsTypeOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_strict1[simp]:
"(invalid::Person) .oclIsTypeOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemma OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_strict2[simp]:
"(null::Person) .oclIsTypeOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
subsection‹Up Down Casting›
lemma actualType_larger_staticType:
assumes isdef: "τ ⊨ (δ X)"
shows "τ ⊨ (X::Person) .oclIsTypeOf(OclAny) ≜ false"
using isdef
by(auto simp : null_option_def bot_option_def
OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person foundation22 foundation16)
lemma down_cast_type:
assumes isOclAny: "τ ⊨ (X::OclAny) .oclIsTypeOf(OclAny)"
and non_null: "τ ⊨ (δ X)"
shows "τ ⊨ (X .oclAsType(Person)) ≜ invalid"
using isOclAny non_null
apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def
OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny foundation22 foundation16
split: option.split type⇩O⇩c⇩l⇩A⇩n⇩y.split type⇩P⇩e⇩r⇩s⇩o⇩n.split)
by(simp add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny OclValid_def false_def true_def)
lemma down_cast_type':
assumes isOclAny: "τ ⊨ (X::OclAny) .oclIsTypeOf(OclAny)"
and non_null: "τ ⊨ (δ X)"
shows "τ ⊨ not (υ (X .oclAsType(Person)))"
by(rule foundation15[THEN iffD1], simp add: down_cast_type[OF assms])
lemma up_down_cast :
assumes isdef: "τ ⊨ (δ X)"
shows "τ ⊨ ((X::Person) .oclAsType(OclAny) .oclAsType(Person) ≜ X)"
using isdef
by(auto simp : null_fun_def null_option_def bot_option_def null_def invalid_def
OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny foundation22 foundation16
split: option.split type⇩P⇩e⇩r⇩s⇩o⇩n.split)
lemma up_down_cast_Person_OclAny_Person [simp]:
shows "((X::Person) .oclAsType(OclAny) .oclAsType(Person) = X)"
apply(rule ext, rename_tac τ)
apply(rule foundation22[THEN iffD1])
apply(case_tac "τ ⊨ (δ X)", simp add: up_down_cast)
apply(simp add: defined_split, elim disjE)
apply(erule StrongEq_L_subst2_rev, simp, simp)+
done
lemma up_down_cast_Person_OclAny_Person':
assumes "τ ⊨ υ X"
shows "τ ⊨ (((X :: Person) .oclAsType(OclAny) .oclAsType(Person)) ≐ X)"
apply(simp only: up_down_cast_Person_OclAny_Person StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n)
by(rule StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_sym, simp add: assms)
lemma up_down_cast_Person_OclAny_Person'':
assumes "τ ⊨ υ (X :: Person)"
shows "τ ⊨ (X .oclIsTypeOf(Person) implies (X .oclAsType(OclAny) .oclAsType(Person)) ≐ X)"
apply(simp add: OclValid_def)
apply(subst cp_OclImplies)
apply(simp add: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_sym[OF assms, simplified OclValid_def])
apply(subst cp_OclImplies[symmetric])
by simp
section‹OclIsKindOf›
subsection‹Definition›
consts OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y :: "'α ⇒ Boolean" ("(_).oclIsKindOf'(OclAny')")
consts OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n :: "'α ⇒ Boolean" ("(_).oclIsKindOf'(Person')")
overloading OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y ≡ "OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y :: OclAny ⇒ Boolean"
begin
definition OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny:
"(X::OclAny) .oclIsKindOf(OclAny) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| _ ⇒ true τ)"
end
overloading OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y ≡ "OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y :: Person ⇒ Boolean"
begin
definition OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person:
"(X::Person) .oclIsKindOf(OclAny) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| _⇒ true τ)"
end
overloading OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n ≡ "OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n :: OclAny ⇒ Boolean"
begin
definition OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny:
"(X::OclAny) .oclIsKindOf(Person) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| ⌊⊥⌋ ⇒ true τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⊥ ⌋⌋ ⇒ false τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊_⌋ ⌋⌋ ⇒ true τ)"
end
overloading OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n ≡ "OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n :: Person ⇒ Boolean"
begin
definition OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person:
"(X::Person) .oclIsKindOf(Person) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| _ ⇒ true τ)"
end
text_raw‹\isatagafp›
subsection‹Context Passing›
lemma cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_Person: "cp P ⟹ cp(λX.(P(X::Person)::Person).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_OclAny: "cp P ⟹ cp(λX.(P(X::OclAny)::OclAny).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_Person: "cp P ⟹ cp(λX.(P(X::Person)::Person).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemma cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_OclAny: "cp P ⟹ cp(λX.(P(X::OclAny)::OclAny).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_OclAny: "cp P ⟹ cp(λX.(P(X::Person)::OclAny).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_Person: "cp P ⟹ cp(λX.(P(X::OclAny)::Person).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_OclAny: "cp P ⟹ cp(λX.(P(X::Person)::OclAny).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_Person: "cp P ⟹ cp(λX.(P(X::OclAny)::Person).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemmas [simp] =
cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_Person
cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_OclAny
cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_Person
cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_OclAny
cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_OclAny
cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_Person
cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_OclAny
cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_Person
text_raw‹\endisatagafp›
subsection‹Execution with Invalid or Null as Argument›
lemma OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_strict1[simp] : "(invalid::OclAny) .oclIsKindOf(OclAny) = invalid"
by(rule ext, simp add: invalid_def bot_option_def
OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_strict2[simp] : "(null::OclAny) .oclIsKindOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def
OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_strict1[simp] : "(invalid::Person) .oclIsKindOf(OclAny) = invalid"
by(rule ext, simp add: bot_option_def invalid_def
OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_strict2[simp] : "(null::Person) .oclIsKindOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def
OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_strict1[simp]: "(invalid::OclAny) .oclIsKindOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_strict2[simp]: "(null::OclAny) .oclIsKindOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_strict1[simp]: "(invalid::Person) .oclIsKindOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemma OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_strict2[simp]: "(null::Person) .oclIsKindOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
subsection‹Up Down Casting›
lemma actualKind_larger_staticKind:
assumes isdef: "τ ⊨ (δ X)"
shows "τ ⊨ ((X::Person) .oclIsKindOf(OclAny) ≜ true)"
using isdef
by(auto simp : bot_option_def
OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person foundation22 foundation16)
lemma down_cast_kind:
assumes isOclAny: "¬ (τ ⊨ ((X::OclAny).oclIsKindOf(Person)))"
and non_null: "τ ⊨ (δ X)"
shows "τ ⊨ ((X .oclAsType(Person)) ≜ invalid)"
using isOclAny non_null
apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def
OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny foundation22 foundation16
split: option.split type⇩O⇩c⇩l⇩A⇩n⇩y.split type⇩P⇩e⇩r⇩s⇩o⇩n.split)
by(simp add: OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny OclValid_def false_def true_def)
section‹OclAllInstances›
text‹To denote OCL-types occurring in OCL expressions syntactically---as, for example, as
``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection
functions into the object universes; we show that this is sufficient ``characterization.''›
definition "Person ≡ OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄"
definition "OclAny ≡ OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄"
lemmas [simp] = Person_def OclAny_def
lemma OclAllInstances_generic⇩O⇩c⇩l⇩A⇩n⇩y_exec: "OclAllInstances_generic pre_post OclAny =
(λτ. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ Some ` OclAny ` ran (heap (pre_post τ)) ⌋⌋)"
proof -
let ?S1 = "λτ. OclAny ` ran (heap (pre_post τ))"
let ?S2 = "λτ. ?S1 τ - {None}"
have B : "⋀τ. ?S2 τ ⊆ ?S1 τ" by auto
have C : "⋀τ. ?S1 τ ⊆ ?S2 τ" by(auto simp: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄_some)
show ?thesis by(insert equalityI[OF B C], simp)
qed
lemma OclAllInstances_at_post⇩O⇩c⇩l⇩A⇩n⇩y_exec: "OclAny .allInstances() =
(λτ. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ Some ` OclAny ` ran (heap (snd τ)) ⌋⌋)"
unfolding OclAllInstances_at_post_def
by(rule OclAllInstances_generic⇩O⇩c⇩l⇩A⇩n⇩y_exec)
lemma OclAllInstances_at_pre⇩O⇩c⇩l⇩A⇩n⇩y_exec: "OclAny .allInstances@pre() =
(λτ. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ Some ` OclAny ` ran (heap (fst τ)) ⌋⌋) "
unfolding OclAllInstances_at_pre_def
by(rule OclAllInstances_generic⇩O⇩c⇩l⇩A⇩n⇩y_exec)
subsection‹OclIsTypeOf›
lemma OclAny_allInstances_generic_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y1:
assumes [simp]: "⋀x. pre_post (x, x) = x"
shows "∃τ. (τ ⊨ ((OclAllInstances_generic pre_post OclAny)->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(OclAny))))"
apply(rule_tac x = τ⇩0 in exI, simp add: τ⇩0_def OclValid_def del: OclAllInstances_generic_def)
apply(simp only: assms UML_Set.OclForall_def refl if_True
OclAllInstances_generic_defined[simplified OclValid_def])
apply(simp only: OclAllInstances_generic_def)
apply(subst (1 2 3) Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def)
by(simp add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma OclAny_allInstances_at_post_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y1:
"∃τ. (τ ⊨ (OclAny .allInstances()->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_post_def
by(rule OclAny_allInstances_generic_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y1, simp)
lemma OclAny_allInstances_at_pre_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y1:
"∃τ. (τ ⊨ (OclAny .allInstances@pre()->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_pre_def
by(rule OclAny_allInstances_generic_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y1, simp)
lemma OclAny_allInstances_generic_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y2:
assumes [simp]: "⋀x. pre_post (x, x) = x"
shows "∃τ. (τ ⊨ not ((OclAllInstances_generic pre_post OclAny)->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(OclAny))))"
proof - fix oid a let ?t0 = "⦇heap = Map.empty(oid ↦ in⇩O⇩c⇩l⇩A⇩n⇩y (mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊a⌋)),
assocs = Map.empty⦈" show ?thesis
apply(rule_tac x = "(?t0, ?t0)" in exI, simp add: OclValid_def del: OclAllInstances_generic_def)
apply(simp only: UML_Set.OclForall_def refl if_True
OclAllInstances_generic_defined[simplified OclValid_def])
apply(simp only: OclAllInstances_generic_def OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄_def)
apply(subst (1 2 3) Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def)
by(simp add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny OclNot_def OclAny_def)
qed
lemma OclAny_allInstances_at_post_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y2:
"∃τ. (τ ⊨ not (OclAny .allInstances()->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_post_def
by(rule OclAny_allInstances_generic_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y2, simp)
lemma OclAny_allInstances_at_pre_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y2:
"∃τ. (τ ⊨ not (OclAny .allInstances@pre()->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_pre_def
by(rule OclAny_allInstances_generic_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y2, simp)
lemma Person_allInstances_generic_oclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n:
"τ ⊨ ((OclAllInstances_generic pre_post Person)->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(Person)))"
apply(simp add: OclValid_def del: OclAllInstances_generic_def)
apply(simp only: UML_Set.OclForall_def refl if_True
OclAllInstances_generic_defined[simplified OclValid_def])
apply(simp only: OclAllInstances_generic_def)
apply(subst (1 2 3) Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def)
by(simp add: OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemma Person_allInstances_at_post_oclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n:
"τ ⊨ (Person .allInstances()->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(Person)))"
unfolding OclAllInstances_at_post_def
by(rule Person_allInstances_generic_oclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n)
lemma Person_allInstances_at_pre_oclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n:
"τ ⊨ (Person .allInstances@pre()->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(Person)))"
unfolding OclAllInstances_at_pre_def
by(rule Person_allInstances_generic_oclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n)
subsection‹OclIsKindOf›
lemma OclAny_allInstances_generic_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y:
"τ ⊨ ((OclAllInstances_generic pre_post OclAny)->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(OclAny)))"
apply(simp add: OclValid_def del: OclAllInstances_generic_def)
apply(simp only: UML_Set.OclForall_def refl if_True
OclAllInstances_generic_defined[simplified OclValid_def])
apply(simp only: OclAllInstances_generic_def)
apply(subst (1 2 3) Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def)
by(simp add: OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma OclAny_allInstances_at_post_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y:
"τ ⊨ (OclAny .allInstances()->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_post_def
by(rule OclAny_allInstances_generic_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y)
lemma OclAny_allInstances_at_pre_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y:
"τ ⊨ (OclAny .allInstances@pre()->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_pre_def
by(rule OclAny_allInstances_generic_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y)
lemma Person_allInstances_generic_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y:
"τ ⊨ ((OclAllInstances_generic pre_post Person)->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(OclAny)))"
apply(simp add: OclValid_def del: OclAllInstances_generic_def)
apply(simp only: UML_Set.OclForall_def refl if_True
OclAllInstances_generic_defined[simplified OclValid_def])
apply(simp only: OclAllInstances_generic_def)
apply(subst (1 2 3) Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def)
by(simp add: OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma Person_allInstances_at_post_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y:
"τ ⊨ (Person .allInstances()->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_post_def
by(rule Person_allInstances_generic_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y)
lemma Person_allInstances_at_pre_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y:
"τ ⊨ (Person .allInstances@pre()->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_pre_def
by(rule Person_allInstances_generic_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y)
lemma Person_allInstances_generic_oclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n:
"τ ⊨ ((OclAllInstances_generic pre_post Person)->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(Person)))"
apply(simp add: OclValid_def del: OclAllInstances_generic_def)
apply(simp only: UML_Set.OclForall_def refl if_True
OclAllInstances_generic_defined[simplified OclValid_def])
apply(simp only: OclAllInstances_generic_def)
apply(subst (1 2 3) Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def)
by(simp add: OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemma Person_allInstances_at_post_oclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n:
"τ ⊨ (Person .allInstances()->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(Person)))"
unfolding OclAllInstances_at_post_def
by(rule Person_allInstances_generic_oclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n)
lemma Person_allInstances_at_pre_oclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n:
"τ ⊨ (Person .allInstances@pre()->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(Person)))"
unfolding OclAllInstances_at_pre_def
by(rule Person_allInstances_generic_oclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n)
section‹The Accessors (any, boss, salary)›
text‹\label{sec:eam-accessors}›
text‹Should be generated entirely from a class-diagram.›
subsection‹Definition (of the association Employee-Boss)›
text‹We start with a oid for the association; this oid can be used
in presence of association classes to represent the association inside an object,
pretty much similar to the \inlineisar+Design_UML+, where we stored
an \verb+oid+ inside the class as ``pointer.''›
definition oid⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮 ::"oid" where "oid⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮 = 10"
text‹From there on, we can already define an empty state which must contain
for $\mathit{oid}_{Person}\mathcal{BOSS}$ the empty relation (encoded as association list, since there are
associations with a Sequence-like structure).›
definition eval_extract :: "('𝔄,('a::object) option option) val
⇒ (oid ⇒ ('𝔄,'c::null) val)
⇒ ('𝔄,'c::null) val"
where "eval_extract X f = (λ τ. case X τ of
⊥ ⇒ invalid τ
| ⌊ ⊥ ⌋ ⇒ invalid τ
| ⌊⌊ obj ⌋⌋ ⇒ f (oid_of obj) τ)"
definition "choose⇩2_1 = fst"
definition "choose⇩2_2 = snd"
definition "List_flatten = (λl. (foldl ((λacc. (λl. (foldl ((λacc. (λl. (Cons (l) (acc))))) (acc) ((rev (l))))))) (Nil) ((rev (l)))))"
definition "deref_assocs⇩2" :: "('𝔄 state × '𝔄 state ⇒ '𝔄 state)
⇒ (oid list list ⇒ oid list × oid list)
⇒ oid
⇒ (oid list ⇒ ('𝔄,'f)val)
⇒ oid
⇒ ('𝔄, 'f::null)val"
where "deref_assocs⇩2 pre_post to_from assoc_oid f oid =
(λτ. case (assocs (pre_post τ)) assoc_oid of
⌊ S ⌋ ⇒ f (List_flatten (map (choose⇩2_2 ∘ to_from)
(filter (λ p. List.member (choose⇩2_1 (to_from p)) oid) S)))
τ
| _ ⇒ invalid τ)"
text‹The ‹pre_post›-parameter is configured with ‹fst› or
‹snd›, the ‹to_from›-parameter either with the identity @{term id} or
the following combinator ‹switch›:›
definition "switch⇩2_1 = (λ[x,y]⇒ (x,y))"
definition "switch⇩2_2 = (λ[x,y]⇒ (y,x))"
definition "switch⇩3_1 = (λ[x,y,z]⇒ (x,y))"
definition "switch⇩3_2 = (λ[x,y,z]⇒ (x,z))"
definition "switch⇩3_3 = (λ[x,y,z]⇒ (y,x))"
definition "switch⇩3_4 = (λ[x,y,z]⇒ (y,z))"
definition "switch⇩3_5 = (λ[x,y,z]⇒ (z,x))"
definition "switch⇩3_6 = (λ[x,y,z]⇒ (z,y))"
definition deref_oid⇩P⇩e⇩r⇩s⇩o⇩n :: "(𝔄 state × 𝔄 state ⇒ 𝔄 state)
⇒ (type⇩P⇩e⇩r⇩s⇩o⇩n ⇒ (𝔄, 'c::null)val)
⇒ oid
⇒ (𝔄, 'c::null)val"
where "deref_oid⇩P⇩e⇩r⇩s⇩o⇩n fst_snd f oid = (λτ. case (heap (fst_snd τ)) oid of
⌊ in⇩P⇩e⇩r⇩s⇩o⇩n obj ⌋ ⇒ f obj τ
| _ ⇒ invalid τ)"
definition deref_oid⇩O⇩c⇩l⇩A⇩n⇩y :: "(𝔄 state × 𝔄 state ⇒ 𝔄 state)
⇒ (type⇩O⇩c⇩l⇩A⇩n⇩y ⇒ (𝔄, 'c::null)val)
⇒ oid
⇒ (𝔄, 'c::null)val"
where "deref_oid⇩O⇩c⇩l⇩A⇩n⇩y fst_snd f oid = (λτ. case (heap (fst_snd τ)) oid of
⌊ in⇩O⇩c⇩l⇩A⇩n⇩y obj ⌋ ⇒ f obj τ
| _ ⇒ invalid τ)"
text‹pointer undefined in state or not referencing a type conform object representation›
definition "select⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴 f = (λ X. case X of
(mk⇩O⇩c⇩l⇩A⇩n⇩y _ ⊥) ⇒ null
| (mk⇩O⇩c⇩l⇩A⇩n⇩y _ ⌊any⌋) ⇒ f (λx _. ⌊⌊x⌋⌋) any)"
definition "select⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮 f = select_object mtSet UML_Set.OclIncluding UML_Set.OclANY (f (λx _. ⌊⌊x⌋⌋))"
definition "select⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴 f = (λ X. case X of
(mk⇩P⇩e⇩r⇩s⇩o⇩n _ ⊥) ⇒ null
| (mk⇩P⇩e⇩r⇩s⇩o⇩n _ ⌊salary⌋) ⇒ f (λx _. ⌊⌊x⌋⌋) salary)"
definition "deref_assocs⇩2ℬ𝒪𝒮𝒮 fst_snd f = (λ mk⇩P⇩e⇩r⇩s⇩o⇩n oid _ ⇒
deref_assocs⇩2 fst_snd switch⇩2_1 oid⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮 f oid)"
definition "in_pre_state = fst"
definition "in_post_state = snd"
definition "reconst_basetype = (λ convert x. convert x)"
definition dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴 :: "OclAny ⇒ _" ("(1(_).any)" 50)
where "(X).any = eval_extract X
(deref_oid⇩O⇩c⇩l⇩A⇩n⇩y in_post_state
(select⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴
reconst_basetype))"
definition dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮 :: "Person ⇒ Person" ("(1(_).boss)" 50)
where "(X).boss = eval_extract X
(deref_oid⇩P⇩e⇩r⇩s⇩o⇩n in_post_state
(deref_assocs⇩2ℬ𝒪𝒮𝒮 in_post_state
(select⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮
(deref_oid⇩P⇩e⇩r⇩s⇩o⇩n in_post_state))))"
definition dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴 :: "Person ⇒ Integer" ("(1(_).salary)" 50)
where "(X).salary = eval_extract X
(deref_oid⇩P⇩e⇩r⇩s⇩o⇩n in_post_state
(select⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴
reconst_basetype))"
definition dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_at_pre :: "OclAny ⇒ _" ("(1(_).any@pre)" 50)
where "(X).any@pre = eval_extract X
(deref_oid⇩O⇩c⇩l⇩A⇩n⇩y in_pre_state
(select⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴
reconst_basetype))"
definition dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre:: "Person ⇒ Person" ("(1(_).boss@pre)" 50)
where "(X).boss@pre = eval_extract X
(deref_oid⇩P⇩e⇩r⇩s⇩o⇩n in_pre_state
(deref_assocs⇩2ℬ𝒪𝒮𝒮 in_pre_state
(select⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮
(deref_oid⇩P⇩e⇩r⇩s⇩o⇩n in_pre_state))))"
definition dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre:: "Person ⇒ Integer" ("(1(_).salary@pre)" 50)
where "(X).salary@pre = eval_extract X
(deref_oid⇩P⇩e⇩r⇩s⇩o⇩n in_pre_state
(select⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴
reconst_basetype))"
lemmas dot_accessor =
dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_def
dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_def
dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_def
dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_at_pre_def
dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre_def
dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_def
subsection‹Context Passing›
lemmas [simp] = eval_extract_def
lemma cp_dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴: "((X).any) τ = ((λ_. X τ).any) τ" by (simp add: dot_accessor)
lemma cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮: "((X).boss) τ = ((λ_. X τ).boss) τ" by (simp add: dot_accessor)
lemma cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴: "((X).salary) τ = ((λ_. X τ).salary) τ" by (simp add: dot_accessor)
lemma cp_dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_at_pre: "((X).any@pre) τ = ((λ_. X τ).any@pre) τ" by (simp add: dot_accessor)
lemma cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre: "((X).boss@pre) τ = ((λ_. X τ).boss@pre) τ" by (simp add: dot_accessor)
lemma cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre: "((X).salary@pre) τ = ((λ_. X τ).salary@pre) τ" by (simp add: dot_accessor)
lemmas cp_dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_I [simp, intro!]=
cp_dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴[THEN allI[THEN allI],
of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_at_pre_I [simp, intro!]=
cp_dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_at_pre[THEN allI[THEN allI],
of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_I [simp, intro!]=
cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮[THEN allI[THEN allI],
of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre_I [simp, intro!]=
cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre[THEN allI[THEN allI],
of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_I [simp, intro!]=
cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴[THEN allI[THEN allI],
of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_I [simp, intro!]=
cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre[THEN allI[THEN allI],
of "λ X _. X" "λ _ τ. τ", THEN cpI1]
subsection‹Execution with Invalid or Null as Argument›
lemma dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_nullstrict [simp]: "(null).any = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_at_pre_nullstrict [simp] : "(null).any@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_strict [simp] : "(invalid).any = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_at_pre_strict [simp] : "(invalid).any@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_nullstrict [simp]: "(null).boss = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre_nullstrict [simp] : "(null).boss@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_strict [simp] : "(invalid).boss = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre_strict [simp] : "(invalid).boss@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_nullstrict [simp]: "(null).salary = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_nullstrict [simp] : "(null).salary@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_strict [simp] : "(invalid).salary = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_strict [simp] : "(invalid).salary@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
subsection‹Representation in States›
lemma dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_def_mono:"τ ⊨ δ(X .boss) ⟹ τ ⊨ δ(X)"
apply(case_tac "τ ⊨ (X ≜ invalid)", insert StrongEq_L_subst2[where P = "(λx. (δ (x .boss)))" and τ = "τ" and x = "X" and y = "invalid"], simp add: foundation16')
apply(case_tac "τ ⊨ (X ≜ null)", insert StrongEq_L_subst2[where P = "(λx. (δ (x .boss)))" and τ = "τ" and x = "X" and y = "null"], simp add: foundation16')
by(simp add: defined_split)
lemma repr_boss:
assumes A : "τ ⊨ δ(x .boss)"
shows "is_represented_in_state in_post_state (x .boss) Person τ"
apply(insert A[simplified foundation16]
A[THEN dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_def_mono, simplified foundation16])
unfolding is_represented_in_state_def
dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_def eval_extract_def select⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_def in_post_state_def
oops
lemma repr_bossX :
assumes A: "τ ⊨ δ(x .boss)"
shows "τ ⊨ ((Person .allInstances()) ->includes⇩S⇩e⇩t(x .boss))"
oops
section‹A Little Infra-structure on Example States›
text‹
The example we are defining in this section comes from the figure~\ref{fig:eam1_system-states}.
\begin{figure}
\includegraphics[width=\textwidth]{figures/pre-post.pdf}
\caption{(a) pre-state $\sigma_1$ and
(b) post-state $\sigma_1'$.}
\label{fig:eam1_system-states}
\end{figure}
›
text_raw‹\isatagafp›
definition OclInt1000 ("𝟭𝟬𝟬𝟬") where "OclInt1000 = (λ _ . ⌊⌊1000⌋⌋)"
definition OclInt1200 ("𝟭𝟮𝟬𝟬") where "OclInt1200 = (λ _ . ⌊⌊1200⌋⌋)"
definition OclInt1300 ("𝟭𝟯𝟬𝟬") where "OclInt1300 = (λ _ . ⌊⌊1300⌋⌋)"
definition OclInt1800 ("𝟭𝟴𝟬𝟬") where "OclInt1800 = (λ _ . ⌊⌊1800⌋⌋)"
definition OclInt2600 ("𝟮𝟲𝟬𝟬") where "OclInt2600 = (λ _ . ⌊⌊2600⌋⌋)"
definition OclInt2900 ("𝟮𝟵𝟬𝟬") where "OclInt2900 = (λ _ . ⌊⌊2900⌋⌋)"
definition OclInt3200 ("𝟯𝟮𝟬𝟬") where "OclInt3200 = (λ _ . ⌊⌊3200⌋⌋)"
definition OclInt3500 ("𝟯𝟱𝟬𝟬") where "OclInt3500 = (λ _ . ⌊⌊3500⌋⌋)"
definition "oid0 ≡ 0"
definition "oid1 ≡ 1"
definition "oid2 ≡ 2"
definition "oid3 ≡ 3"
definition "oid4 ≡ 4"
definition "oid5 ≡ 5"
definition "oid6 ≡ 6"
definition "oid7 ≡ 7"
definition "oid8 ≡ 8"
definition "person1 ≡ mk⇩P⇩e⇩r⇩s⇩o⇩n oid0 ⌊1300⌋"
definition "person2 ≡ mk⇩P⇩e⇩r⇩s⇩o⇩n oid1 ⌊1800⌋"
definition "person3 ≡ mk⇩P⇩e⇩r⇩s⇩o⇩n oid2 None"
definition "person4 ≡ mk⇩P⇩e⇩r⇩s⇩o⇩n oid3 ⌊2900⌋"
definition "person5 ≡ mk⇩P⇩e⇩r⇩s⇩o⇩n oid4 ⌊3500⌋"
definition "person6 ≡ mk⇩P⇩e⇩r⇩s⇩o⇩n oid5 ⌊2500⌋"
definition "person7 ≡ mk⇩O⇩c⇩l⇩A⇩n⇩y oid6 ⌊⌊3200⌋⌋"
definition "person8 ≡ mk⇩O⇩c⇩l⇩A⇩n⇩y oid7 None"
definition "person9 ≡ mk⇩P⇩e⇩r⇩s⇩o⇩n oid8 ⌊0⌋"
text_raw‹\endisatagafp›
definition
"σ⇩1 ≡ ⦇ heap = Map.empty(oid0 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n (mk⇩P⇩e⇩r⇩s⇩o⇩n oid0 ⌊1000⌋))
(oid1 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n (mk⇩P⇩e⇩r⇩s⇩o⇩n oid1 ⌊1200⌋))
(oid3 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n (mk⇩P⇩e⇩r⇩s⇩o⇩n oid3 ⌊2600⌋))
(oid4 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person5)
(oid5 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n (mk⇩P⇩e⇩r⇩s⇩o⇩n oid5 ⌊2300⌋))
(oid8 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person9),
assocs = Map.empty(oid⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮 ↦ [[[oid0],[oid1]],[[oid3],[oid4]],[[oid5],[oid3]]]) ⦈"
definition
"σ⇩1' ≡ ⦇ heap = Map.empty(oid0 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person1)
(oid1 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person2)
(oid2 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person3)
(oid3 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person4)
(oid5 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person6)
(oid6 ↦ in⇩O⇩c⇩l⇩A⇩n⇩y person7)
(oid7 ↦ in⇩O⇩c⇩l⇩A⇩n⇩y person8)
(oid8 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person9),
assocs = Map.empty(oid⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮 ↦ [[[oid0],[oid1]],[[oid1],[oid1]],[[oid5],[oid6]],[[oid6],[oid6]]]) ⦈"
definition "σ⇩0 ≡ ⦇ heap = Map.empty, assocs = Map.empty ⦈"
lemma basic_τ_wff: "WFF(σ⇩1,σ⇩1')"
by(auto simp: WFF_def σ⇩1_def σ⇩1'_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
oid_of_𝔄_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def oid_of_type⇩O⇩c⇩l⇩A⇩n⇩y_def
person1_def person2_def person3_def person4_def
person5_def person6_def person7_def person8_def person9_def)
lemma [simp,code_unfold]: "dom (heap σ⇩1) = {oid0,oid1,oid3,oid4,oid5,oid8}"
by(auto simp: σ⇩1_def)
lemma [simp,code_unfold]: "dom (heap σ⇩1') = {oid0,oid1,oid2,oid3,oid5,oid6,oid7,oid8}"
by(auto simp: σ⇩1'_def)
text_raw‹\isatagafp›
definition "X⇩P⇩e⇩r⇩s⇩o⇩n1 :: Person ≡ λ _ .⌊⌊ person1 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n2 :: Person ≡ λ _ .⌊⌊ person2 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n3 :: Person ≡ λ _ .⌊⌊ person3 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n4 :: Person ≡ λ _ .⌊⌊ person4 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n5 :: Person ≡ λ _ .⌊⌊ person5 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n6 :: Person ≡ λ _ .⌊⌊ person6 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n7 :: OclAny ≡ λ _ .⌊⌊ person7 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n8 :: OclAny ≡ λ _ .⌊⌊ person8 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n9 :: Person ≡ λ _ .⌊⌊ person9 ⌋⌋"
lemma [code_unfold]: "((x::Person) ≐ y) = StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x y" by(simp only: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n)
lemma [code_unfold]: "((x::OclAny) ≐ y) = StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x y" by(simp only: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩O⇩c⇩l⇩A⇩n⇩y)
lemmas [simp,code_unfold] =
OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny
OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person
OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny
OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person
OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny
OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person
OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny
OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person
OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny
OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person
OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny
OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person
text_raw‹\endisatagafp›
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .salary <> 𝟭𝟬𝟬𝟬)"
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .salary ≐ 𝟭𝟯𝟬𝟬)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .salary@pre ≐ 𝟭𝟬𝟬𝟬)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .salary@pre <> 𝟭𝟯𝟬𝟬)"
lemma " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def
σ⇩1_def σ⇩1'_def
X⇩P⇩e⇩r⇩s⇩o⇩n1_def person1_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def)
lemma "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ ((X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclAsType(OclAny) .oclAsType(Person)) ≐ X⇩P⇩e⇩r⇩s⇩o⇩n1)"
by(rule up_down_cast_Person_OclAny_Person', simp add: X⇩P⇩e⇩r⇩s⇩o⇩n1_def)
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclIsTypeOf(Person))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ not(X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclIsTypeOf(OclAny))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclIsKindOf(Person))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclIsKindOf(OclAny))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ not(X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclAsType(OclAny) .oclIsTypeOf(OclAny))"
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n2 .salary ≐ 𝟭𝟴𝟬𝟬)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n2 .salary@pre ≐ 𝟭𝟮𝟬𝟬)"
lemma " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n2 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def σ⇩1_def σ⇩1'_def X⇩P⇩e⇩r⇩s⇩o⇩n2_def person2_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def)
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n3 .salary ≐ null)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n3 .salary@pre))"
lemma " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n3 .oclIsNew())"
by(simp add: OclValid_def OclIsNew_def σ⇩1_def σ⇩1'_def X⇩P⇩e⇩r⇩s⇩o⇩n3_def person3_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def
oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def)
lemma " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n4 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def σ⇩1_def σ⇩1'_def X⇩P⇩e⇩r⇩s⇩o⇩n4_def person4_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def)
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n5 .salary))"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n5 .salary@pre ≐ 𝟯𝟱𝟬𝟬)"
lemma " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n5 .oclIsDeleted())"
by(simp add: OclNot_def OclValid_def OclIsDeleted_def σ⇩1_def σ⇩1'_def X⇩P⇩e⇩r⇩s⇩o⇩n5_def person5_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def)
lemma " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n6 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def σ⇩1_def σ⇩1'_def X⇩P⇩e⇩r⇩s⇩o⇩n6_def person6_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def)
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ υ(X⇩P⇩e⇩r⇩s⇩o⇩n7 .oclAsType(Person))"
lemma "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ ((X⇩P⇩e⇩r⇩s⇩o⇩n7 .oclAsType(Person) .oclAsType(OclAny)
.oclAsType(Person))
≐ (X⇩P⇩e⇩r⇩s⇩o⇩n7 .oclAsType(Person)))"
by(rule up_down_cast_Person_OclAny_Person', simp add: X⇩P⇩e⇩r⇩s⇩o⇩n7_def OclValid_def valid_def person7_def)
lemma " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n7 .oclIsNew())"
by(simp add: OclValid_def OclIsNew_def σ⇩1_def σ⇩1'_def X⇩P⇩e⇩r⇩s⇩o⇩n7_def person7_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def
oid_of_option_def oid_of_type⇩O⇩c⇩l⇩A⇩n⇩y_def)
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n8 <> X⇩P⇩e⇩r⇩s⇩o⇩n7)"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n8 .oclAsType(Person)))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n8 .oclIsTypeOf(OclAny))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ not(X⇩P⇩e⇩r⇩s⇩o⇩n8 .oclIsTypeOf(Person))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ not(X⇩P⇩e⇩r⇩s⇩o⇩n8 .oclIsKindOf(Person))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n8 .oclIsKindOf(OclAny))"
lemma σ_modifiedonly: "(σ⇩1,σ⇩1') ⊨ (Set{ X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclAsType(OclAny)
, X⇩P⇩e⇩r⇩s⇩o⇩n2 .oclAsType(OclAny)
, X⇩P⇩e⇩r⇩s⇩o⇩n4 .oclAsType(OclAny)
, X⇩P⇩e⇩r⇩s⇩o⇩n6 .oclAsType(OclAny)
}->oclIsModifiedOnly())"
apply(simp add: OclIsModifiedOnly_def OclValid_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
X⇩P⇩e⇩r⇩s⇩o⇩n1_def X⇩P⇩e⇩r⇩s⇩o⇩n2_def X⇩P⇩e⇩r⇩s⇩o⇩n3_def X⇩P⇩e⇩r⇩s⇩o⇩n4_def
X⇩P⇩e⇩r⇩s⇩o⇩n5_def X⇩P⇩e⇩r⇩s⇩o⇩n6_def X⇩P⇩e⇩r⇩s⇩o⇩n7_def X⇩P⇩e⇩r⇩s⇩o⇩n8_def X⇩P⇩e⇩r⇩s⇩o⇩n9_def
person1_def person2_def person3_def person4_def
person5_def person6_def person7_def person8_def person9_def
image_def)
apply(simp add: OclIncluding_rep_set mtSet_rep_set null_option_def bot_option_def)
apply(simp add: oid_of_option_def oid_of_type⇩O⇩c⇩l⇩A⇩n⇩y_def, clarsimp)
apply(simp add: σ⇩1_def σ⇩1'_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
done
lemma "(σ⇩1,σ⇩1') ⊨ ((X⇩P⇩e⇩r⇩s⇩o⇩n9 @pre (λx. ⌊OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄 x⌋)) ≜ X⇩P⇩e⇩r⇩s⇩o⇩n9)"
by(simp add: OclSelf_at_pre_def σ⇩1_def oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def
X⇩P⇩e⇩r⇩s⇩o⇩n9_def person9_def oid8_def OclValid_def StrongEq_def OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def)
lemma "(σ⇩1,σ⇩1') ⊨ ((X⇩P⇩e⇩r⇩s⇩o⇩n9 @post (λx. ⌊OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄 x⌋)) ≜ X⇩P⇩e⇩r⇩s⇩o⇩n9)"
by(simp add: OclSelf_at_post_def σ⇩1'_def oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def
X⇩P⇩e⇩r⇩s⇩o⇩n9_def person9_def oid8_def OclValid_def StrongEq_def OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def)
lemma "(σ⇩1,σ⇩1') ⊨ (((X⇩P⇩e⇩r⇩s⇩o⇩n9 .oclAsType(OclAny)) @pre (λx. ⌊OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄 x⌋)) ≜
((X⇩P⇩e⇩r⇩s⇩o⇩n9 .oclAsType(OclAny)) @post (λx. ⌊OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄 x⌋)))"
proof -
have including4 : "⋀a b c d τ.
Set{λτ. ⌊⌊a⌋⌋, λτ. ⌊⌊b⌋⌋, λτ. ⌊⌊c⌋⌋, λτ. ⌊⌊d⌋⌋} τ = Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ {⌊⌊a⌋⌋, ⌊⌊b⌋⌋, ⌊⌊c⌋⌋, ⌊⌊d⌋⌋} ⌋⌋"
apply(subst abs_rep_simp'[symmetric], simp)
apply(simp add: OclIncluding_rep_set mtSet_rep_set)
by(rule arg_cong[of _ _ "λx. (Abs_Set⇩b⇩a⇩s⇩e(⌊⌊ x ⌋⌋))"], auto)
have excluding1: "⋀S a b c d e τ.
(λ_. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ {⌊⌊a⌋⌋, ⌊⌊b⌋⌋, ⌊⌊c⌋⌋, ⌊⌊d⌋⌋} ⌋⌋)->excluding⇩S⇩e⇩t(λτ. ⌊⌊e⌋⌋) τ =
Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ {⌊⌊a⌋⌋, ⌊⌊b⌋⌋, ⌊⌊c⌋⌋, ⌊⌊d⌋⌋} - {⌊⌊e⌋⌋} ⌋⌋"
apply(simp add: UML_Set.OclExcluding_def)
apply(simp add: defined_def OclValid_def false_def true_def
bot_fun_def bot_Set⇩b⇩a⇩s⇩e_def null_fun_def null_Set⇩b⇩a⇩s⇩e_def)
apply(rule conjI)
apply(rule impI, subst (asm) Abs_Set⇩b⇩a⇩s⇩e_inject) apply( simp add: bot_option_def)+
apply(rule conjI)
apply(rule impI, subst (asm) Abs_Set⇩b⇩a⇩s⇩e_inject) apply( simp add: bot_option_def null_option_def)+
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def, simp)
done
show ?thesis
apply(rule framing[where X = "Set{ X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclAsType(OclAny)
, X⇩P⇩e⇩r⇩s⇩o⇩n2 .oclAsType(OclAny)
, X⇩P⇩e⇩r⇩s⇩o⇩n4 .oclAsType(OclAny)
, X⇩P⇩e⇩r⇩s⇩o⇩n6 .oclAsType(OclAny)
}"])
apply(cut_tac σ_modifiedonly)
apply(simp only: OclValid_def
X⇩P⇩e⇩r⇩s⇩o⇩n1_def X⇩P⇩e⇩r⇩s⇩o⇩n2_def X⇩P⇩e⇩r⇩s⇩o⇩n3_def X⇩P⇩e⇩r⇩s⇩o⇩n4_def
X⇩P⇩e⇩r⇩s⇩o⇩n5_def X⇩P⇩e⇩r⇩s⇩o⇩n6_def X⇩P⇩e⇩r⇩s⇩o⇩n7_def X⇩P⇩e⇩r⇩s⇩o⇩n8_def X⇩P⇩e⇩r⇩s⇩o⇩n9_def
person1_def person2_def person3_def person4_def
person5_def person6_def person7_def person8_def person9_def
OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person)
apply(subst cp_OclIsModifiedOnly, subst UML_Set.OclExcluding.cp0,
subst (asm) cp_OclIsModifiedOnly, simp add: including4 excluding1)
apply(simp only: X⇩P⇩e⇩r⇩s⇩o⇩n1_def X⇩P⇩e⇩r⇩s⇩o⇩n2_def X⇩P⇩e⇩r⇩s⇩o⇩n3_def X⇩P⇩e⇩r⇩s⇩o⇩n4_def
X⇩P⇩e⇩r⇩s⇩o⇩n5_def X⇩P⇩e⇩r⇩s⇩o⇩n6_def X⇩P⇩e⇩r⇩s⇩o⇩n7_def X⇩P⇩e⇩r⇩s⇩o⇩n8_def X⇩P⇩e⇩r⇩s⇩o⇩n9_def
person1_def person2_def person3_def person4_def
person5_def person6_def person7_def person8_def person9_def)
apply(simp add: OclIncluding_rep_set mtSet_rep_set
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
apply(simp add: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def oid_of_option_def oid_of_type⇩O⇩c⇩l⇩A⇩n⇩y_def OclNot_def OclValid_def
null_option_def bot_option_def)
done
qed
lemma perm_σ⇩1' : "σ⇩1' = ⦇ heap = Map.empty
(oid8 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person9)
(oid7 ↦ in⇩O⇩c⇩l⇩A⇩n⇩y person8)
(oid6 ↦ in⇩O⇩c⇩l⇩A⇩n⇩y person7)
(oid5 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person6)
(oid3 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person4)
(oid2 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person3)
(oid1 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person2)
(oid0 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person1)
, assocs = assocs σ⇩1' ⦈"
proof -
note P = fun_upd_twist
show ?thesis
apply(simp add: σ⇩1'_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
apply(subst (1) P, simp)
apply(subst (2) P, simp) apply(subst (1) P, simp)
apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
apply(subst (7) P, simp) apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
by(simp)
qed
declare const_ss [simp]
lemma "⋀σ⇩1.
(σ⇩1,σ⇩1') ⊨ (Person .allInstances() ≐ Set{ X⇩P⇩e⇩r⇩s⇩o⇩n1, X⇩P⇩e⇩r⇩s⇩o⇩n2, X⇩P⇩e⇩r⇩s⇩o⇩n3, X⇩P⇩e⇩r⇩s⇩o⇩n4, X⇩P⇩e⇩r⇩s⇩o⇩n6,
X⇩P⇩e⇩r⇩s⇩o⇩n7 .oclAsType(Person), X⇩P⇩e⇩r⇩s⇩o⇩n9 })"
apply(subst perm_σ⇩1')
apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
X⇩P⇩e⇩r⇩s⇩o⇩n1_def X⇩P⇩e⇩r⇩s⇩o⇩n2_def X⇩P⇩e⇩r⇩s⇩o⇩n3_def X⇩P⇩e⇩r⇩s⇩o⇩n4_def
X⇩P⇩e⇩r⇩s⇩o⇩n5_def X⇩P⇩e⇩r⇩s⇩o⇩n6_def X⇩P⇩e⇩r⇩s⇩o⇩n7_def X⇩P⇩e⇩r⇩s⇩o⇩n8_def X⇩P⇩e⇩r⇩s⇩o⇩n9_def
person7_def)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
apply(subst state_update_vs_allInstances_at_post_ntc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def
person8_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
apply(rule state_update_vs_allInstances_at_post_empty)
by(simp_all add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def)
lemma "⋀σ⇩1.
(σ⇩1,σ⇩1') ⊨ (OclAny .allInstances() ≐ Set{ X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclAsType(OclAny), X⇩P⇩e⇩r⇩s⇩o⇩n2 .oclAsType(OclAny),
X⇩P⇩e⇩r⇩s⇩o⇩n3 .oclAsType(OclAny), X⇩P⇩e⇩r⇩s⇩o⇩n4 .oclAsType(OclAny)
, X⇩P⇩e⇩r⇩s⇩o⇩n6 .oclAsType(OclAny),
X⇩P⇩e⇩r⇩s⇩o⇩n7, X⇩P⇩e⇩r⇩s⇩o⇩n8, X⇩P⇩e⇩r⇩s⇩o⇩n9 .oclAsType(OclAny) })"
apply(subst perm_σ⇩1')
apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
X⇩P⇩e⇩r⇩s⇩o⇩n1_def X⇩P⇩e⇩r⇩s⇩o⇩n2_def X⇩P⇩e⇩r⇩s⇩o⇩n3_def X⇩P⇩e⇩r⇩s⇩o⇩n4_def X⇩P⇩e⇩r⇩s⇩o⇩n5_def X⇩P⇩e⇩r⇩s⇩o⇩n6_def X⇩P⇩e⇩r⇩s⇩o⇩n7_def X⇩P⇩e⇩r⇩s⇩o⇩n8_def X⇩P⇩e⇩r⇩s⇩o⇩n9_def
person1_def person2_def person3_def person4_def person5_def person6_def person9_def)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)+
apply(rule state_update_vs_allInstances_at_post_empty)
by(simp_all add: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄_def)
end
Theory Analysis_OCL
theory
Analysis_OCL
imports
Analysis_UML
begin
text ‹\label{ex:employee-analysis:ocl}›
section‹OCL Part: Invariant›
text‹These recursive predicates can be defined conservatively
by greatest fix-point
constructions---automatically. See~\cite{brucker.ea:hol-ocl-book:2006,brucker:interactive:2007}
for details. For the purpose of this example, we state them as axioms
here.
\begin{ocl}
context Person
inv label : self .boss <> null implies (self .salary ≤ ((self .boss) .salary))
\end{ocl}
›
definition Person_label⇩i⇩n⇩v :: "Person ⇒ Boolean"
where "Person_label⇩i⇩n⇩v (self) ≡
(self .boss <> null implies (self .salary ≤⇩i⇩n⇩t ((self .boss) .salary)))"
definition Person_label⇩i⇩n⇩v⇩A⇩T⇩p⇩r⇩e :: "Person ⇒ Boolean"
where "Person_label⇩i⇩n⇩v⇩A⇩T⇩p⇩r⇩e (self) ≡
(self .boss@pre <> null implies (self .salary@pre ≤⇩i⇩n⇩t ((self .boss@pre) .salary@pre)))"
definition Person_label⇩g⇩l⇩o⇩b⇩a⇩l⇩i⇩n⇩v :: "Boolean"
where "Person_label⇩g⇩l⇩o⇩b⇩a⇩l⇩i⇩n⇩v ≡ (Person .allInstances()->forAll⇩S⇩e⇩t(x | Person_label⇩i⇩n⇩v (x)) and
(Person .allInstances@pre()->forAll⇩S⇩e⇩t(x | Person_label⇩i⇩n⇩v⇩A⇩T⇩p⇩r⇩e (x))))"
lemma "τ ⊨ δ (X .boss) ⟹ τ ⊨ Person .allInstances()->includes⇩S⇩e⇩t(X .boss) ∧
τ ⊨ Person .allInstances()->includes⇩S⇩e⇩t(X) "
oops
lemma REC_pre : "τ ⊨ Person_label⇩g⇩l⇩o⇩b⇩a⇩l⇩i⇩n⇩v
⟹ τ ⊨ Person .allInstances()->includes⇩S⇩e⇩t(X)
⟹ ∃ REC. τ ⊨ REC(X) ≜ (Person_label⇩i⇩n⇩v (X) and (X .boss <> null implies REC(X .boss)))"
oops
text‹This allows to state a predicate:›
axiomatization inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l :: "Person ⇒ Boolean"
where inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l_def:
"(τ ⊨ Person .allInstances()->includes⇩S⇩e⇩t(self)) ⟹
(τ ⊨ (inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l(self) ≜ (self .boss <> null implies
(self .salary ≤⇩i⇩n⇩t ((self .boss) .salary)) and
inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l(self .boss))))"
axiomatization inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l⇩A⇩T⇩p⇩r⇩e :: "Person ⇒ Boolean"
where inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l⇩A⇩T⇩p⇩r⇩e_def:
"(τ ⊨ Person .allInstances@pre()->includes⇩S⇩e⇩t(self)) ⟹
(τ ⊨ (inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l⇩A⇩T⇩p⇩r⇩e(self) ≜ (self .boss@pre <> null implies
(self .salary@pre ≤⇩i⇩n⇩t ((self .boss@pre) .salary@pre)) and
inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l⇩A⇩T⇩p⇩r⇩e(self .boss@pre))))"
lemma inv_1 :
"(τ ⊨ Person .allInstances()->includes⇩S⇩e⇩t(self)) ⟹
(τ ⊨ inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l(self) = ((τ ⊨ (self .boss ≐ null)) ∨
( τ ⊨ (self .boss <> null) ∧
τ ⊨ ((self .salary) ≤⇩i⇩n⇩t (self .boss .salary)) ∧
τ ⊨ (inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l(self .boss))))) "
oops
lemma inv_2 :
"(τ ⊨ Person .allInstances@pre()->includes⇩S⇩e⇩t(self)) ⟹
(τ ⊨ inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l⇩A⇩T⇩p⇩r⇩e(self)) = ((τ ⊨ (self .boss@pre ≐ null)) ∨
(τ ⊨ (self .boss@pre <> null) ∧
(τ ⊨ (self .boss@pre .salary@pre ≤⇩i⇩n⇩t self .salary@pre)) ∧
(τ ⊨ (inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l⇩A⇩T⇩p⇩r⇩e(self .boss@pre)))))"
oops
text‹A very first attempt to characterize the axiomatization by an inductive
definition - this can not be the last word since too weak (should be equality!)›
coinductive inv :: "Person ⇒ (𝔄)st ⇒ bool" where
"(τ ⊨ (δ self)) ⟹ ((τ ⊨ (self .boss ≐ null)) ∨
(τ ⊨ (self .boss <> null) ∧ (τ ⊨ (self .boss .salary ≤⇩i⇩n⇩t self .salary)) ∧
( (inv(self .boss))τ )))
⟹ ( inv self τ)"
section‹OCL Part: The Contract of a Recursive Query›
text‹The original specification of a recursive query :
\begin{ocl}
context Person::contents():Set(Integer)
pre: true
post: result = if self.boss = null
then Set{i}
else self.boss.contents()->including(i)
endif
\end{ocl}›
text‹For the case of recursive queries, we use at present just axiomatizations:›
axiomatization contents :: "Person ⇒ Set_Integer" ("(1(_).contents'('))" 50)
where contents_def:
"(self .contents()) = (λ τ. SOME res. let res = λ _. res in
if τ ⊨ (δ self)
then ((τ ⊨ true) ∧
(τ ⊨ res ≜ if (self .boss ≐ null)
then (Set{self .salary})
else (self .boss .contents()
->including⇩S⇩e⇩t(self .salary))
endif))
else τ ⊨ res ≜ invalid)"
and cp0_contents:"(X .contents()) τ = ((λ_. X τ) .contents()) τ"
interpretation contents : contract0 "contents" "λ self. true"
"λ self res. res ≜ if (self .boss ≐ null)
then (Set{self .salary})
else (self .boss .contents()
->including⇩S⇩e⇩t(self .salary))
endif"
proof (unfold_locales)
show "⋀self τ. true τ = true τ" by auto
next
show "⋀self. ∀σ σ' σ''. ((σ, σ') ⊨ true) = ((σ, σ'') ⊨ true)" by auto
next
show "⋀self. self .contents() ≡
λ τ. SOME res. let res = λ _. res in
if τ ⊨ (δ self)
then ((τ ⊨ true) ∧
(τ ⊨ res ≜ if (self .boss ≐ null)
then (Set{self .salary})
else (self .boss .contents()
->including⇩S⇩e⇩t(self .salary))
endif))
else τ ⊨ res ≜ invalid"
by(auto simp: contents_def )
next
have A:"⋀self τ. ((λ_. self τ) .boss ≐ null) τ = (λ_. (self .boss ≐ null) τ) τ"
by (metis (no_types) StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n cp_StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮)
have B:"⋀self τ. (λ_. Set{(λ_. self τ) .salary} τ) = (λ_. Set{self .salary} τ)"
apply(subst UML_Set.OclIncluding.cp0)
apply(subst (2) UML_Set.OclIncluding.cp0)
apply(subst (2) Analysis_UML.cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴) by simp
have C:"⋀self τ. ((λ_. self τ).boss .contents()->including⇩S⇩e⇩t((λ_. self τ).salary) τ) =
(self .boss .contents() ->including⇩S⇩e⇩t(self .salary) τ)"
apply(subst UML_Set.OclIncluding.cp0) apply(subst (2) UML_Set.OclIncluding.cp0)
apply(subst (2) Analysis_UML.cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴)
apply(subst cp0_contents) apply(subst (2) cp0_contents)
apply(subst (2) cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮) by simp
show "⋀self res τ.
(res ≜ if (self .boss) ≐ null then Set{self .salary}
else self .boss .contents()->including⇩S⇩e⇩t(self .salary) endif) τ =
((λ_. res τ) ≜ if (λ_. self τ) .boss ≐ null then Set{(λ_. self τ) .salary}
else(λ_. self τ) .boss .contents()->including⇩S⇩e⇩t((λ_. self τ) .salary) endif) τ"
apply(subst cp_StrongEq)
apply(subst (2) cp_StrongEq)
apply(subst cp_OclIf)
apply(subst (2)cp_OclIf)
by(simp add: A B C)
qed
text‹Specializing @{thm contents.unfold2}, one gets the following more practical rewrite
rule that is amenable to symbolic evaluation:›
theorem unfold_contents :
assumes "cp E"
and "τ ⊨ δ self"
shows "(τ ⊨ E (self .contents())) =
(τ ⊨ E (if self .boss ≐ null
then Set{self .salary}
else self .boss .contents()->including⇩S⇩e⇩t(self .salary) endif))"
by(rule contents.unfold2[of _ _ _ "λ X. true"], simp_all add: assms)
text‹Since we have only one interpretation function, we need the corresponding
operation on the pre-state:›
consts contentsATpre :: "Person ⇒ Set_Integer" ("(1(_).contents@pre'('))" 50)
axiomatization where contentsATpre_def:
" (self).contents@pre() = (λ τ.
SOME res. let res = λ _. res in
if τ ⊨ (δ self)
then ((τ ⊨ true) ∧
(τ ⊨ (res ≜ if (self).boss@pre ≐ null
then Set{(self).salary@pre}
else (self).boss@pre .contents@pre()
->including⇩S⇩e⇩t(self .salary@pre)
endif)))
else τ ⊨ res ≜ invalid)"
and cp0_contents_at_pre:"(X .contents@pre()) τ = ((λ_. X τ) .contents@pre()) τ"
interpretation contentsATpre : contract0 "contentsATpre" "λ self. true"
"λ self res. res ≜ if (self .boss@pre ≐ null)
then (Set{self .salary@pre})
else (self .boss@pre .contents@pre()
->including⇩S⇩e⇩t(self .salary@pre))
endif"
proof (unfold_locales)
show "⋀self τ. true τ = true τ" by auto
next
show "⋀self. ∀σ σ' σ''. ((σ, σ') ⊨ true) = ((σ, σ'') ⊨ true)" by auto
next
show "⋀self. self .contents@pre() ≡
λτ. SOME res. let res = λ _. res in
if τ ⊨ δ self
then τ ⊨ true ∧
τ ⊨ res ≜ (if self .boss@pre ≐ null then Set{self .salary@pre}
else self .boss@pre .contents@pre()->including⇩S⇩e⇩t(self .salary@pre)
endif)
else τ ⊨ res ≜ invalid"
by(auto simp: contentsATpre_def)
next
have A:"⋀self τ. ((λ_. self τ) .boss@pre ≐ null) τ = (λ_. (self .boss@pre ≐ null) τ) τ"
by (metis StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n cp_StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre)
have B:"⋀self τ. (λ_. Set{(λ_. self τ) .salary@pre} τ) = (λ_. Set{self .salary@pre} τ)"
apply(subst UML_Set.OclIncluding.cp0)
apply(subst (2) UML_Set.OclIncluding.cp0)
apply(subst (2) Analysis_UML.cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre) by simp
have C:"⋀self τ. ((λ_. self τ).boss@pre .contents@pre()->including⇩S⇩e⇩t((λ_. self τ).salary@pre) τ) =
(self .boss@pre .contents@pre() ->including⇩S⇩e⇩t(self .salary@pre) τ)"
apply(subst UML_Set.OclIncluding.cp0) apply(subst (2) UML_Set.OclIncluding.cp0)
apply(subst (2) Analysis_UML.cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre)
apply(subst cp0_contents_at_pre) apply(subst (2) cp0_contents_at_pre)
apply(subst (2) cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre) by simp
show "⋀self res τ.
(res ≜ if (self .boss@pre) ≐ null then Set{self .salary@pre}
else self .boss@pre .contents@pre()->including⇩S⇩e⇩t(self .salary@pre) endif) τ =
((λ_. res τ) ≜ if (λ_. self τ) .boss@pre ≐ null then Set{(λ_. self τ) .salary@pre}
else(λ_. self τ) .boss@pre .contents@pre()->including⇩S⇩e⇩t((λ_. self τ) .salary@pre) endif) τ"
apply(subst cp_StrongEq)
apply(subst (2) cp_StrongEq)
apply(subst cp_OclIf)
apply(subst (2)cp_OclIf)
by(simp add: A B C)
qed
text‹Again, we derive via @{thm [source] contents.unfold2} a Knaster-Tarski like Fixpoint rule
that is amenable to symbolic evaluation:›
theorem unfold_contentsATpre :
assumes "cp E"
and "τ ⊨ δ self"
shows "(τ ⊨ E (self .contents@pre())) =
(τ ⊨ E (if self .boss@pre ≐ null
then Set{self .salary@pre}
else self .boss@pre .contents@pre()->including⇩S⇩e⇩t(self .salary@pre) endif))"
by(rule contentsATpre.unfold2[of _ _ _ "λ X. true"], simp_all add: assms)
text‹Note that these \inlineocl{@pre} variants on methods are only available on queries, \ie,
operations without side-effect.›
section‹OCL Part: The Contract of a User-defined Method›
text‹
The example specification in high-level OCL input syntax reads as follows:
\begin{ocl}
context Person::insert(x:Integer)
pre: true
post: contents():Set(Integer)
contents() = contents@pre()->including(x)
\end{ocl}
This boils down to:
›
definition insert :: "Person ⇒Integer ⇒ Void" ("(1(_).insert'(_'))" 50)
where "self .insert(x) ≡
(λ τ. SOME res. let res = λ _. res in
if (τ ⊨ (δ self)) ∧ (τ ⊨ υ x)
then (τ ⊨ true ∧
(τ ⊨ ((self).contents() ≜ (self).contents@pre()->including⇩S⇩e⇩t(x))))
else τ ⊨ res ≜ invalid)"
text‹The semantic consequences of this definition were computed inside this locale interpretation:›
interpretation insert : contract1 "insert" "λ self x. true"
"λ self x res. ((self .contents()) ≜
(self .contents@pre()->including⇩S⇩e⇩t(x)))"
apply unfold_locales apply(auto simp:insert_def)
apply(subst cp_StrongEq) apply(subst (2) cp_StrongEq)
apply(subst contents.cp0)
apply(subst UML_Set.OclIncluding.cp0)
apply(subst (2) UML_Set.OclIncluding.cp0)
apply(subst contentsATpre.cp0)
by(simp)
text‹The result of this locale interpretation for our @{term insert} contract is the following
set of properties, which serves as basis for automated deduction on them:
\begin{table}[htbp]
\centering
\begin{tabu}{lX[,c,]}
\toprule
Name & Theorem \\
\midrule
@{thm [source] insert.strict0} & @{thm [display=false] insert.strict0} \\
@{thm [source] insert.nullstrict0} & @{thm [display=false] insert.nullstrict0} \\
@{thm [source] insert.strict1} & @{thm [display=false] insert.strict1} \\
@{thm [source] insert.cp⇩P⇩R⇩E} & @{thm [display=false] insert.cp⇩P⇩R⇩E} \\
@{thm [source] insert.cp⇩P⇩O⇩S⇩T} & @{thm [display=false] insert.cp⇩P⇩O⇩S⇩T} \\
@{thm [source] insert.cp_pre} & @{thm [display=false] insert.cp_pre} \\
@{thm [source] insert.cp_post} & @{thm [display=false] insert.cp_post} \\
@{thm [source] insert.cp} & @{thm [display=false] insert.cp} \\
@{thm [source] insert.cp0} & @{thm [display=false] insert.cp0} \\
@{thm [source] insert.def_scheme} & @{thm [display=false] insert.def_scheme} \\
@{thm [source] insert.unfold} & @{thm [display=false] insert.unfold} \\
@{thm [source] insert.unfold2} & @{thm [display=false] insert.unfold2} \\
\bottomrule
\end{tabu}
\caption{Semantic properties resulting from a user-defined operation contract.}
\label{tab:sem_operation_contract}
\end{table}
›
end
Theory Design_UML
chapter‹Example: The Employee Design Model›
theory
Design_UML
imports
"../../../UML_Main"
begin
text ‹\label{ex:employee-design:uml}›
section‹Introduction›
text‹
For certain concepts like classes and class-types, only a generic
definition for its resulting semantics can be given. Generic means,
there is a function outside HOL that ``compiles'' a concrete,
closed-world class diagram into a ``theory'' of this data model,
consisting of a bunch of definitions for classes, accessors, method,
casts, and tests for actual types, as well as proofs for the
fundamental properties of these operations in this concrete data
model.›
text‹Such generic function or ``compiler'' can be implemented in
Isabelle on the ML level. This has been done, for a semantics
following the open-world assumption, for UML 2.0
in~\cite{brucker.ea:extensible:2008-b, brucker:interactive:2007}. In
this paper, we follow another approach for UML 2.4: we define the
concepts of the compilation informally, and present a concrete
example which is verified in Isabelle/HOL.›
subsection‹Outlining the Example›
text‹We are presenting here a ``design-model'' of the (slightly
modified) example Figure 7.3, page 20 of
the OCL standard~\cite{omg:ocl:2012}. To be precise, this theory contains the formalization of
the data-part covered by the UML class model (see \autoref{fig:person}):›
text‹
\begin{figure}
\centering\scalebox{.3}{\includegraphics{figures/person.png}}%
\caption{A simple UML class model drawn from Figure 7.3,
page 20 of~\cite{omg:ocl:2012}. \label{fig:person}}
\end{figure}
›
text‹This means that the association (attached to the association class
\inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented
by the attribute \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the OCL part
captured by the subsequent theory).
›
section‹Example Data-Universe and its Infrastructure›
text‹Ideally, the following is generated automatically from a UML class model.›
text‹Our data universe consists in the concrete class diagram just of node's,
and implicitly of the class object. Each class implies the existence of a class
type defined for the corresponding object representations as follows:›
datatype type⇩P⇩e⇩r⇩s⇩o⇩n = mk⇩P⇩e⇩r⇩s⇩o⇩n oid
"int option"
"oid option"
datatype type⇩O⇩c⇩l⇩A⇩n⇩y = mk⇩O⇩c⇩l⇩A⇩n⇩y oid
"(int option × oid option) option"
text‹Now, we construct a concrete ``universe of OclAny types'' by injection into a
sum type containing the class types. This type of OclAny will be used as instance
for all respective type-variables.›
datatype 𝔄 = in⇩P⇩e⇩r⇩s⇩o⇩n type⇩P⇩e⇩r⇩s⇩o⇩n | in⇩O⇩c⇩l⇩A⇩n⇩y type⇩O⇩c⇩l⇩A⇩n⇩y
text‹Having fixed the object universe, we can introduce type synonyms that exactly correspond
to OCL types. Again, we exploit that our representation of OCL is a ``shallow embedding'' with a
one-to-one correspondance of OCL-types to types of the meta-language HOL.›
type_synonym Boolean = " 𝔄 Boolean"
type_synonym Integer = " 𝔄 Integer"
type_synonym Void = " 𝔄 Void"
type_synonym OclAny = "(𝔄, type⇩O⇩c⇩l⇩A⇩n⇩y option option) val"
type_synonym Person = "(𝔄, type⇩P⇩e⇩r⇩s⇩o⇩n option option) val"
type_synonym Set_Integer = "(𝔄, int option option) Set"
type_synonym Set_Person = "(𝔄, type⇩P⇩e⇩r⇩s⇩o⇩n option option) Set"
text‹Just a little check:›
typ "Boolean"
text‹To reuse key-elements of the library like referential equality, we have
to show that the object universe belongs to the type class ``oclany,'' \ie,
each class type has to provide a function @{term oid_of} yielding the object id (oid) of the object.›
instantiation type⇩P⇩e⇩r⇩s⇩o⇩n :: object
begin
definition oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def: "oid_of x = (case x of mk⇩P⇩e⇩r⇩s⇩o⇩n oid _ _ ⇒ oid)"
instance ..
end
instantiation type⇩O⇩c⇩l⇩A⇩n⇩y :: object
begin
definition oid_of_type⇩O⇩c⇩l⇩A⇩n⇩y_def: "oid_of x = (case x of mk⇩O⇩c⇩l⇩A⇩n⇩y oid _ ⇒ oid)"
instance ..
end
instantiation 𝔄 :: object
begin
definition oid_of_𝔄_def: "oid_of x = (case x of
in⇩P⇩e⇩r⇩s⇩o⇩n person ⇒ oid_of person
| in⇩O⇩c⇩l⇩A⇩n⇩y oclany ⇒ oid_of oclany)"
instance ..
end
section‹Instantiation of the Generic Strict Equality›
text‹We instantiate the referential equality
on ‹Person› and ‹OclAny››
overloading StrictRefEq ≡ "StrictRefEq :: [Person,Person] ⇒ Boolean"
begin
definition StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n : "(x::Person) ≐ y ≡ StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x y"
end
overloading StrictRefEq ≡ "StrictRefEq :: [OclAny,OclAny] ⇒ Boolean"
begin
definition StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩O⇩c⇩l⇩A⇩n⇩y : "(x::OclAny) ≐ y ≡ StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x y"
end
lemmas cps23 =
cp_StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t[of "x::Person" "y::Person" "τ",
simplified StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n[symmetric]]
cp_intro(9) [of "P::Person ⇒Person""Q::Person ⇒Person",
simplified StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n[symmetric] ]
StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def [of "x::Person" "y::Person",
simplified StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n[symmetric]]
StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_defargs [of _ "x::Person" "y::Person",
simplified StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n[symmetric]]
StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_strict1
[of "x::Person",
simplified StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n[symmetric]]
StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_strict2
[of "x::Person",
simplified StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n[symmetric]]
for x y τ P Q
text‹For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)},
a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form
\inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator.
›
text‹Thus, since we have two class-types in our concrete class hierarchy, we have
two operations to declare and to provide two overloading definitions for the two static types.
›
section‹OclAsType›
subsection‹Definition›
consts OclAsType⇩O⇩c⇩l⇩A⇩n⇩y :: "'α ⇒ OclAny" ("(_) .oclAsType'(OclAny')")
consts OclAsType⇩P⇩e⇩r⇩s⇩o⇩n :: "'α ⇒ Person" ("(_) .oclAsType'(Person')")
definition "OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄 = (λu. ⌊case u of in⇩O⇩c⇩l⇩A⇩n⇩y a ⇒ a
| in⇩P⇩e⇩r⇩s⇩o⇩n (mk⇩P⇩e⇩r⇩s⇩o⇩n oid a b) ⇒ mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊(a,b)⌋⌋)"
lemma OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄_some: "OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄 x ≠ None"
by(simp add: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄_def)
overloading OclAsType⇩O⇩c⇩l⇩A⇩n⇩y ≡ "OclAsType⇩O⇩c⇩l⇩A⇩n⇩y :: OclAny ⇒ OclAny"
begin
definition OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny:
"(X::OclAny) .oclAsType(OclAny) ≡ X"
end
overloading OclAsType⇩O⇩c⇩l⇩A⇩n⇩y ≡ "OclAsType⇩O⇩c⇩l⇩A⇩n⇩y :: Person ⇒ OclAny"
begin
definition OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person:
"(X::Person) .oclAsType(OclAny) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| ⌊⊥⌋ ⇒ null τ
| ⌊⌊mk⇩P⇩e⇩r⇩s⇩o⇩n oid a b ⌋⌋ ⇒ ⌊⌊ (mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊(a,b)⌋) ⌋⌋)"
end
definition "OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄 =
(λu. case u of in⇩P⇩e⇩r⇩s⇩o⇩n p ⇒ ⌊p⌋
| in⇩O⇩c⇩l⇩A⇩n⇩y (mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊(a,b)⌋) ⇒ ⌊mk⇩P⇩e⇩r⇩s⇩o⇩n oid a b⌋
| _ ⇒ None)"
overloading OclAsType⇩P⇩e⇩r⇩s⇩o⇩n ≡ "OclAsType⇩P⇩e⇩r⇩s⇩o⇩n :: OclAny ⇒ Person"
begin
definition OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny:
"(X::OclAny) .oclAsType(Person) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| ⌊⊥⌋ ⇒ null τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⊥ ⌋⌋ ⇒ invalid τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊(a,b)⌋ ⌋⌋ ⇒ ⌊⌊mk⇩P⇩e⇩r⇩s⇩o⇩n oid a b ⌋⌋)"
end
overloading OclAsType⇩P⇩e⇩r⇩s⇩o⇩n ≡ "OclAsType⇩P⇩e⇩r⇩s⇩o⇩n :: Person ⇒ Person"
begin
definition OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person:
"(X::Person) .oclAsType(Person) ≡ X "
end
text_raw‹\isatagafp›
lemmas [simp] =
OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny
OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person
subsection‹Context Passing›
lemma cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person_Person: "cp P ⟹ cp(λX. (P (X::Person)::Person) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_OclAny: "cp P ⟹ cp(λX. (P (X::OclAny)::OclAny) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person_Person: "cp P ⟹ cp(λX. (P (X::Person)::Person) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemma cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_OclAny: "cp P ⟹ cp(λX. (P (X::OclAny)::OclAny) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person_OclAny: "cp P ⟹ cp(λX. (P (X::Person)::OclAny) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_Person: "cp P ⟹ cp(λX. (P (X::OclAny)::Person) .oclAsType(OclAny))"
by(rule cpI1, simp_all add: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person_OclAny: "cp P ⟹ cp(λX. (P (X::Person)::OclAny) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_Person: "cp P ⟹ cp(λX. (P (X::OclAny)::Person) .oclAsType(Person))"
by(rule cpI1, simp_all add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemmas [simp] =
cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person_Person
cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_OclAny
cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person_Person
cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_OclAny
cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person_OclAny
cp_OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_Person
cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person_OclAny
cp_OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_Person
text_raw‹\endisatagafp›
subsection‹Execution with Invalid or Null as Argument›
lemma OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_strict : "(invalid::OclAny) .oclAsType(OclAny) = invalid" by(simp)
lemma OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_nullstrict : "(null::OclAny) .oclAsType(OclAny) = null" by(simp)
lemma OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person_strict[simp] : "(invalid::Person) .oclAsType(OclAny) = invalid"
by(rule ext, simp add: bot_option_def invalid_def OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person_nullstrict[simp] : "(null::Person) .oclAsType(OclAny) = null"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_strict[simp] : "(invalid::OclAny) .oclAsType(Person) = invalid"
by(rule ext, simp add: bot_option_def invalid_def OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_nullstrict[simp] : "(null::OclAny) .oclAsType(Person) = null"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person_strict : "(invalid::Person) .oclAsType(Person) = invalid" by(simp)
lemma OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person_nullstrict : "(null::Person) .oclAsType(Person) = null" by(simp)
section‹OclIsTypeOf›
subsection‹Definition›
consts OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y :: "'α ⇒ Boolean" ("(_).oclIsTypeOf'(OclAny')")
consts OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n :: "'α ⇒ Boolean" ("(_).oclIsTypeOf'(Person')")
overloading OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y ≡ "OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y :: OclAny ⇒ Boolean"
begin
definition OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny:
"(X::OclAny) .oclIsTypeOf(OclAny) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| ⌊⊥⌋ ⇒ true τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⊥ ⌋⌋ ⇒ true τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊_⌋ ⌋⌋ ⇒ false τ)"
end
lemma OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny':
"(X::OclAny) .oclIsTypeOf(OclAny) =
(λ τ. if τ ⊨ υ X then (case X τ of
⌊⊥⌋ ⇒ true τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⊥ ⌋⌋ ⇒ true τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊_⌋ ⌋⌋ ⇒ false τ)
else invalid τ)"
apply(rule ext, simp add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
by(case_tac "τ ⊨ υ X", auto simp: foundation18' bot_option_def)
interpretation OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny :
profile_mono_schemeV
"OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y::OclAny ⇒ Boolean"
"λ X. (case X of
⌊None⌋ ⇒ ⌊⌊True⌋⌋
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid None ⌋⌋ ⇒ ⌊⌊True⌋⌋
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊_⌋ ⌋⌋ ⇒ ⌊⌊False⌋⌋)"
apply(unfold_locales, simp add: atomize_eq, rule ext)
by(auto simp: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny' OclValid_def true_def false_def
split: option.split type⇩O⇩c⇩l⇩A⇩n⇩y.split)
overloading OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y ≡ "OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y :: Person ⇒ Boolean"
begin
definition OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person:
"(X::Person) .oclIsTypeOf(OclAny) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| ⌊⊥⌋ ⇒ true τ
| ⌊⌊ _ ⌋⌋ ⇒ false τ) "
end
overloading OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n ≡ "OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n :: OclAny ⇒ Boolean"
begin
definition OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny:
"(X::OclAny) .oclIsTypeOf(Person) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| ⌊⊥⌋ ⇒ true τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⊥ ⌋⌋ ⇒ false τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊_⌋ ⌋⌋ ⇒ true τ)"
end
overloading OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n ≡ "OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n :: Person ⇒ Boolean"
begin
definition OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person:
"(X::Person) .oclIsTypeOf(Person) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| _ ⇒ true τ)"
end
text_raw‹\isatagafp›
subsection‹Context Passing›
lemma cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_Person: "cp P ⟹ cp(λX.(P(X::Person)::Person).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_OclAny: "cp P ⟹ cp(λX.(P(X::OclAny)::OclAny).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_Person: "cp P ⟹ cp(λX.(P(X::Person)::Person).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemma cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_OclAny: "cp P ⟹ cp(λX.(P(X::OclAny)::OclAny).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_OclAny: "cp P ⟹ cp(λX.(P(X::Person)::OclAny).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_Person: "cp P ⟹ cp(λX.(P(X::OclAny)::Person).oclIsTypeOf(OclAny))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_OclAny: "cp P ⟹ cp(λX.(P(X::Person)::OclAny).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_Person: "cp P ⟹ cp(λX.(P(X::OclAny)::Person).oclIsTypeOf(Person))"
by(rule cpI1, simp_all add: OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemmas [simp] =
cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_Person
cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_OclAny
cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_Person
cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_OclAny
cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_OclAny
cp_OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_Person
cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_OclAny
cp_OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_Person
text_raw‹\endisatagafp›
subsection‹Execution with Invalid or Null as Argument›
lemma OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_strict1[simp]:
"(invalid::OclAny) .oclIsTypeOf(OclAny) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_strict2[simp]:
"(null::OclAny) .oclIsTypeOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_strict1[simp]:
"(invalid::Person) .oclIsTypeOf(OclAny) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_strict2[simp]:
"(null::Person) .oclIsTypeOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_strict1[simp]:
"(invalid::OclAny) .oclIsTypeOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_strict2[simp]:
"(null::OclAny) .oclIsTypeOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_strict1[simp]:
"(invalid::Person) .oclIsTypeOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemma OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_strict2[simp]:
"(null::Person) .oclIsTypeOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
subsection‹Up Down Casting›
lemma actualType_larger_staticType:
assumes isdef: "τ ⊨ (δ X)"
shows "τ ⊨ (X::Person) .oclIsTypeOf(OclAny) ≜ false"
using isdef
by(auto simp : null_option_def bot_option_def
OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person foundation22 foundation16)
lemma down_cast_type:
assumes isOclAny: "τ ⊨ (X::OclAny) .oclIsTypeOf(OclAny)"
and non_null: "τ ⊨ (δ X)"
shows "τ ⊨ (X .oclAsType(Person)) ≜ invalid"
using isOclAny non_null
apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def
OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny foundation22 foundation16
split: option.split type⇩O⇩c⇩l⇩A⇩n⇩y.split type⇩P⇩e⇩r⇩s⇩o⇩n.split)
by(simp add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny OclValid_def false_def true_def)
lemma down_cast_type':
assumes isOclAny: "τ ⊨ (X::OclAny) .oclIsTypeOf(OclAny)"
and non_null: "τ ⊨ (δ X)"
shows "τ ⊨ not (υ (X .oclAsType(Person)))"
by(rule foundation15[THEN iffD1], simp add: down_cast_type[OF assms])
lemma up_down_cast :
assumes isdef: "τ ⊨ (δ X)"
shows "τ ⊨ ((X::Person) .oclAsType(OclAny) .oclAsType(Person) ≜ X)"
using isdef
by(auto simp : null_fun_def null_option_def bot_option_def null_def invalid_def
OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny foundation22 foundation16
split: option.split type⇩P⇩e⇩r⇩s⇩o⇩n.split)
lemma up_down_cast_Person_OclAny_Person [simp]:
shows "((X::Person) .oclAsType(OclAny) .oclAsType(Person) = X)"
apply(rule ext, rename_tac τ)
apply(rule foundation22[THEN iffD1])
apply(case_tac "τ ⊨ (δ X)", simp add: up_down_cast)
apply(simp add: defined_split, elim disjE)
apply(erule StrongEq_L_subst2_rev, simp, simp)+
done
lemma up_down_cast_Person_OclAny_Person':
assumes "τ ⊨ υ X"
shows "τ ⊨ (((X :: Person) .oclAsType(OclAny) .oclAsType(Person)) ≐ X)"
apply(simp only: up_down_cast_Person_OclAny_Person StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n)
by(rule StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_sym, simp add: assms)
lemma up_down_cast_Person_OclAny_Person'':
assumes "τ ⊨ υ (X :: Person)"
shows "τ ⊨ (X .oclIsTypeOf(Person) implies (X .oclAsType(OclAny) .oclAsType(Person)) ≐ X)"
apply(simp add: OclValid_def)
apply(subst cp_OclImplies)
apply(simp add: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_sym[OF assms, simplified OclValid_def])
apply(subst cp_OclImplies[symmetric])
by simp
section‹OclIsKindOf›
subsection‹Definition›
consts OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y :: "'α ⇒ Boolean" ("(_).oclIsKindOf'(OclAny')")
consts OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n :: "'α ⇒ Boolean" ("(_).oclIsKindOf'(Person')")
overloading OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y ≡ "OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y :: OclAny ⇒ Boolean"
begin
definition OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny:
"(X::OclAny) .oclIsKindOf(OclAny) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| _ ⇒ true τ)"
end
overloading OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y ≡ "OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y :: Person ⇒ Boolean"
begin
definition OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person:
"(X::Person) .oclIsKindOf(OclAny) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| _⇒ true τ)"
end
overloading OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n ≡ "OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n :: OclAny ⇒ Boolean"
begin
definition OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny:
"(X::OclAny) .oclIsKindOf(Person) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| ⌊⊥⌋ ⇒ true τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⊥ ⌋⌋ ⇒ false τ
| ⌊⌊mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊_⌋ ⌋⌋ ⇒ true τ)"
end
overloading OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n ≡ "OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n :: Person ⇒ Boolean"
begin
definition OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person:
"(X::Person) .oclIsKindOf(Person) ≡
(λτ. case X τ of
⊥ ⇒ invalid τ
| _ ⇒ true τ)"
end
text_raw‹\isatagafp›
subsection‹Context Passing›
lemma cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_Person: "cp P ⟹ cp(λX.(P(X::Person)::Person).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_OclAny: "cp P ⟹ cp(λX.(P(X::OclAny)::OclAny).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_Person: "cp P ⟹ cp(λX.(P(X::Person)::Person).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemma cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_OclAny: "cp P ⟹ cp(λX.(P(X::OclAny)::OclAny).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_OclAny: "cp P ⟹ cp(λX.(P(X::Person)::OclAny).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_Person: "cp P ⟹ cp(λX.(P(X::OclAny)::Person).oclIsKindOf(OclAny))"
by(rule cpI1, simp_all add: OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_OclAny: "cp P ⟹ cp(λX.(P(X::Person)::OclAny).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_Person: "cp P ⟹ cp(λX.(P(X::OclAny)::Person).oclIsKindOf(Person))"
by(rule cpI1, simp_all add: OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemmas [simp] =
cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_Person
cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_OclAny
cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_Person
cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_OclAny
cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_OclAny
cp_OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_Person
cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_OclAny
cp_OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_Person
text_raw‹\endisatagafp›
subsection‹Execution with Invalid or Null as Argument›
lemma OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_strict1[simp] : "(invalid::OclAny) .oclIsKindOf(OclAny) = invalid"
by(rule ext, simp add: invalid_def bot_option_def
OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny_strict2[simp] : "(null::OclAny) .oclIsKindOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def
OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_strict1[simp] : "(invalid::Person) .oclIsKindOf(OclAny) = invalid"
by(rule ext, simp add: bot_option_def invalid_def
OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person_strict2[simp] : "(null::Person) .oclIsKindOf(OclAny) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def
OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_strict1[simp]: "(invalid::OclAny) .oclIsKindOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny_strict2[simp]: "(null::OclAny) .oclIsKindOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny)
lemma OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_strict1[simp]: "(invalid::Person) .oclIsKindOf(Person) = invalid"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemma OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person_strict2[simp]: "(null::Person) .oclIsKindOf(Person) = true"
by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
subsection‹Up Down Casting›
lemma actualKind_larger_staticKind:
assumes isdef: "τ ⊨ (δ X)"
shows "τ ⊨ ((X::Person) .oclIsKindOf(OclAny) ≜ true)"
using isdef
by(auto simp : bot_option_def
OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person foundation22 foundation16)
lemma down_cast_kind:
assumes isOclAny: "¬ (τ ⊨ ((X::OclAny).oclIsKindOf(Person)))"
and non_null: "τ ⊨ (δ X)"
shows "τ ⊨ ((X .oclAsType(Person)) ≜ invalid)"
using isOclAny non_null
apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def
OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny foundation22 foundation16
split: option.split type⇩O⇩c⇩l⇩A⇩n⇩y.split type⇩P⇩e⇩r⇩s⇩o⇩n.split)
by(simp add: OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny OclValid_def false_def true_def)
section‹OclAllInstances›
text‹To denote OCL-types occurring in OCL expressions syntactically---as, for example, as
``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection
functions into the object universes; we show that this is sufficient ``characterization.''›
definition "Person ≡ OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄"
definition "OclAny ≡ OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄"
lemmas [simp] = Person_def OclAny_def
lemma OclAllInstances_generic⇩O⇩c⇩l⇩A⇩n⇩y_exec: "OclAllInstances_generic pre_post OclAny =
(λτ. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ Some ` OclAny ` ran (heap (pre_post τ)) ⌋⌋)"
proof -
let ?S1 = "λτ. OclAny ` ran (heap (pre_post τ))"
let ?S2 = "λτ. ?S1 τ - {None}"
have B : "⋀τ. ?S2 τ ⊆ ?S1 τ" by auto
have C : "⋀τ. ?S1 τ ⊆ ?S2 τ" by(auto simp: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄_some)
show ?thesis by(insert equalityI[OF B C], simp)
qed
lemma OclAllInstances_at_post⇩O⇩c⇩l⇩A⇩n⇩y_exec: "OclAny .allInstances() =
(λτ. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ Some ` OclAny ` ran (heap (snd τ)) ⌋⌋)"
unfolding OclAllInstances_at_post_def
by(rule OclAllInstances_generic⇩O⇩c⇩l⇩A⇩n⇩y_exec)
lemma OclAllInstances_at_pre⇩O⇩c⇩l⇩A⇩n⇩y_exec: "OclAny .allInstances@pre() =
(λτ. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ Some ` OclAny ` ran (heap (fst τ)) ⌋⌋) "
unfolding OclAllInstances_at_pre_def
by(rule OclAllInstances_generic⇩O⇩c⇩l⇩A⇩n⇩y_exec)
subsection‹OclIsTypeOf›
lemma OclAny_allInstances_generic_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y1:
assumes [simp]: "⋀x. pre_post (x, x) = x"
shows "∃τ. (τ ⊨ ((OclAllInstances_generic pre_post OclAny)->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(OclAny))))"
apply(rule_tac x = τ⇩0 in exI, simp add: τ⇩0_def OclValid_def del: OclAllInstances_generic_def)
apply(simp only: assms UML_Set.OclForall_def refl if_True
OclAllInstances_generic_defined[simplified OclValid_def])
apply(simp only: OclAllInstances_generic_def)
apply(subst (1 2 3) Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def)
by(simp add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma OclAny_allInstances_at_post_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y1:
"∃τ. (τ ⊨ (OclAny .allInstances()->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_post_def
by(rule OclAny_allInstances_generic_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y1, simp)
lemma OclAny_allInstances_at_pre_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y1:
"∃τ. (τ ⊨ (OclAny .allInstances@pre()->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_pre_def
by(rule OclAny_allInstances_generic_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y1, simp)
lemma OclAny_allInstances_generic_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y2:
assumes [simp]: "⋀x. pre_post (x, x) = x"
shows "∃τ. (τ ⊨ not ((OclAllInstances_generic pre_post OclAny)->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(OclAny))))"
proof - fix oid a let ?t0 = "⦇heap = Map.empty(oid ↦ in⇩O⇩c⇩l⇩A⇩n⇩y (mk⇩O⇩c⇩l⇩A⇩n⇩y oid ⌊a⌋)),
assocs = Map.empty⦈" show ?thesis
apply(rule_tac x = "(?t0, ?t0)" in exI, simp add: OclValid_def del: OclAllInstances_generic_def)
apply(simp only: UML_Set.OclForall_def refl if_True
OclAllInstances_generic_defined[simplified OclValid_def])
apply(simp only: OclAllInstances_generic_def OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄_def)
apply(subst (1 2 3) Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def)
by(simp add: OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny OclNot_def OclAny_def)
qed
lemma OclAny_allInstances_at_post_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y2:
"∃τ. (τ ⊨ not (OclAny .allInstances()->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_post_def
by(rule OclAny_allInstances_generic_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y2, simp)
lemma OclAny_allInstances_at_pre_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y2:
"∃τ. (τ ⊨ not (OclAny .allInstances@pre()->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(OclAny))))"
unfolding OclAllInstances_at_pre_def
by(rule OclAny_allInstances_generic_oclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y2, simp)
lemma Person_allInstances_generic_oclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n:
"τ ⊨ ((OclAllInstances_generic pre_post Person)->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(Person)))"
apply(simp add: OclValid_def del: OclAllInstances_generic_def)
apply(simp only: UML_Set.OclForall_def refl if_True
OclAllInstances_generic_defined[simplified OclValid_def])
apply(simp only: OclAllInstances_generic_def)
apply(subst (1 2 3) Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def)
by(simp add: OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemma Person_allInstances_at_post_oclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n:
"τ ⊨ (Person .allInstances()->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(Person)))"
unfolding OclAllInstances_at_post_def
by(rule Person_allInstances_generic_oclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n)
lemma Person_allInstances_at_pre_oclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n:
"τ ⊨ (Person .allInstances@pre()->forAll⇩S⇩e⇩t(X|X .oclIsTypeOf(Person)))"
unfolding OclAllInstances_at_pre_def
by(rule Person_allInstances_generic_oclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n)
subsection‹OclIsKindOf›
lemma OclAny_allInstances_generic_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y:
"τ ⊨ ((OclAllInstances_generic pre_post OclAny)->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(OclAny)))"
apply(simp add: OclValid_def del: OclAllInstances_generic_def)
apply(simp only: UML_Set.OclForall_def refl if_True
OclAllInstances_generic_defined[simplified OclValid_def])
apply(simp only: OclAllInstances_generic_def)
apply(subst (1 2 3) Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def)
by(simp add: OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny)
lemma OclAny_allInstances_at_post_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y:
"τ ⊨ (OclAny .allInstances()->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_post_def
by(rule OclAny_allInstances_generic_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y)
lemma OclAny_allInstances_at_pre_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y:
"τ ⊨ (OclAny .allInstances@pre()->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_pre_def
by(rule OclAny_allInstances_generic_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y)
lemma Person_allInstances_generic_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y:
"τ ⊨ ((OclAllInstances_generic pre_post Person)->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(OclAny)))"
apply(simp add: OclValid_def del: OclAllInstances_generic_def)
apply(simp only: UML_Set.OclForall_def refl if_True
OclAllInstances_generic_defined[simplified OclValid_def])
apply(simp only: OclAllInstances_generic_def)
apply(subst (1 2 3) Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def)
by(simp add: OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person)
lemma Person_allInstances_at_post_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y:
"τ ⊨ (Person .allInstances()->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_post_def
by(rule Person_allInstances_generic_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y)
lemma Person_allInstances_at_pre_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y:
"τ ⊨ (Person .allInstances@pre()->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(OclAny)))"
unfolding OclAllInstances_at_pre_def
by(rule Person_allInstances_generic_oclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y)
lemma Person_allInstances_generic_oclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n:
"τ ⊨ ((OclAllInstances_generic pre_post Person)->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(Person)))"
apply(simp add: OclValid_def del: OclAllInstances_generic_def)
apply(simp only: UML_Set.OclForall_def refl if_True
OclAllInstances_generic_defined[simplified OclValid_def])
apply(simp only: OclAllInstances_generic_def)
apply(subst (1 2 3) Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def)
by(simp add: OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person)
lemma Person_allInstances_at_post_oclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n:
"τ ⊨ (Person .allInstances()->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(Person)))"
unfolding OclAllInstances_at_post_def
by(rule Person_allInstances_generic_oclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n)
lemma Person_allInstances_at_pre_oclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n:
"τ ⊨ (Person .allInstances@pre()->forAll⇩S⇩e⇩t(X|X .oclIsKindOf(Person)))"
unfolding OclAllInstances_at_pre_def
by(rule Person_allInstances_generic_oclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n)
section‹The Accessors (any, boss, salary)›
text‹\label{sec:edm-accessors}›
text‹Should be generated entirely from a class-diagram.›
subsection‹Definition›
definition eval_extract :: "('𝔄,('a::object) option option) val
⇒ (oid ⇒ ('𝔄,'c::null) val)
⇒ ('𝔄,'c::null) val"
where "eval_extract X f = (λ τ. case X τ of
⊥ ⇒ invalid τ
| ⌊ ⊥ ⌋ ⇒ invalid τ
| ⌊⌊ obj ⌋⌋ ⇒ f (oid_of obj) τ)"
definition deref_oid⇩P⇩e⇩r⇩s⇩o⇩n :: "(𝔄 state × 𝔄 state ⇒ 𝔄 state)
⇒ (type⇩P⇩e⇩r⇩s⇩o⇩n ⇒ (𝔄, 'c::null)val)
⇒ oid
⇒ (𝔄, 'c::null)val"
where "deref_oid⇩P⇩e⇩r⇩s⇩o⇩n fst_snd f oid = (λτ. case (heap (fst_snd τ)) oid of
⌊ in⇩P⇩e⇩r⇩s⇩o⇩n obj ⌋ ⇒ f obj τ
| _ ⇒ invalid τ)"
definition deref_oid⇩O⇩c⇩l⇩A⇩n⇩y :: "(𝔄 state × 𝔄 state ⇒ 𝔄 state)
⇒ (type⇩O⇩c⇩l⇩A⇩n⇩y ⇒ (𝔄, 'c::null)val)
⇒ oid
⇒ (𝔄, 'c::null)val"
where "deref_oid⇩O⇩c⇩l⇩A⇩n⇩y fst_snd f oid = (λτ. case (heap (fst_snd τ)) oid of
⌊ in⇩O⇩c⇩l⇩A⇩n⇩y obj ⌋ ⇒ f obj τ
| _ ⇒ invalid τ)"
text‹pointer undefined in state or not referencing a type conform object representation›
definition "select⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴 f = (λ X. case X of
(mk⇩O⇩c⇩l⇩A⇩n⇩y _ ⊥) ⇒ null
| (mk⇩O⇩c⇩l⇩A⇩n⇩y _ ⌊any⌋) ⇒ f (λx _. ⌊⌊x⌋⌋) any)"
definition "select⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮 f = (λ X. case X of
(mk⇩P⇩e⇩r⇩s⇩o⇩n _ _ ⊥) ⇒ null
| (mk⇩P⇩e⇩r⇩s⇩o⇩n _ _ ⌊boss⌋) ⇒ f (λx _. ⌊⌊x⌋⌋) boss)"
definition "select⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴 f = (λ X. case X of
(mk⇩P⇩e⇩r⇩s⇩o⇩n _ ⊥ _) ⇒ null
| (mk⇩P⇩e⇩r⇩s⇩o⇩n _ ⌊salary⌋ _) ⇒ f (λx _. ⌊⌊x⌋⌋) salary)"
definition "in_pre_state = fst"
definition "in_post_state = snd"
definition "reconst_basetype = (λ convert x. convert x)"
definition dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴 :: "OclAny ⇒ _" ("(1(_).any)" 50)
where "(X).any = eval_extract X
(deref_oid⇩O⇩c⇩l⇩A⇩n⇩y in_post_state
(select⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴
reconst_basetype))"
definition dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮 :: "Person ⇒ Person" ("(1(_).boss)" 50)
where "(X).boss = eval_extract X
(deref_oid⇩P⇩e⇩r⇩s⇩o⇩n in_post_state
(select⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮
(deref_oid⇩P⇩e⇩r⇩s⇩o⇩n in_post_state)))"
definition dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴 :: "Person ⇒ Integer" ("(1(_).salary)" 50)
where "(X).salary = eval_extract X
(deref_oid⇩P⇩e⇩r⇩s⇩o⇩n in_post_state
(select⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴
reconst_basetype))"
definition dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_at_pre :: "OclAny ⇒ _" ("(1(_).any@pre)" 50)
where "(X).any@pre = eval_extract X
(deref_oid⇩O⇩c⇩l⇩A⇩n⇩y in_pre_state
(select⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴
reconst_basetype))"
definition dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre:: "Person ⇒ Person" ("(1(_).boss@pre)" 50)
where "(X).boss@pre = eval_extract X
(deref_oid⇩P⇩e⇩r⇩s⇩o⇩n in_pre_state
(select⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮
(deref_oid⇩P⇩e⇩r⇩s⇩o⇩n in_pre_state)))"
definition dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre:: "Person ⇒ Integer" ("(1(_).salary@pre)" 50)
where "(X).salary@pre = eval_extract X
(deref_oid⇩P⇩e⇩r⇩s⇩o⇩n in_pre_state
(select⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴
reconst_basetype))"
lemmas dot_accessor =
dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_def
dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_def
dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_def
dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_at_pre_def
dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre_def
dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_def
subsection‹Context Passing›
lemmas [simp] = eval_extract_def
lemma cp_dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴: "((X).any) τ = ((λ_. X τ).any) τ" by (simp add: dot_accessor)
lemma cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮: "((X).boss) τ = ((λ_. X τ).boss) τ" by (simp add: dot_accessor)
lemma cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴: "((X).salary) τ = ((λ_. X τ).salary) τ" by (simp add: dot_accessor)
lemma cp_dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_at_pre: "((X).any@pre) τ = ((λ_. X τ).any@pre) τ" by (simp add: dot_accessor)
lemma cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre: "((X).boss@pre) τ = ((λ_. X τ).boss@pre) τ" by (simp add: dot_accessor)
lemma cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre: "((X).salary@pre) τ = ((λ_. X τ).salary@pre) τ" by (simp add: dot_accessor)
lemmas cp_dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_I [simp, intro!]=
cp_dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴[THEN allI[THEN allI],
of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_at_pre_I [simp, intro!]=
cp_dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_at_pre[THEN allI[THEN allI],
of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_I [simp, intro!]=
cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮[THEN allI[THEN allI],
of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre_I [simp, intro!]=
cp_dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre[THEN allI[THEN allI],
of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_I [simp, intro!]=
cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴[THEN allI[THEN allI],
of "λ X _. X" "λ _ τ. τ", THEN cpI1]
lemmas cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_I [simp, intro!]=
cp_dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre[THEN allI[THEN allI],
of "λ X _. X" "λ _ τ. τ", THEN cpI1]
subsection‹Execution with Invalid or Null as Argument›
lemma dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_nullstrict [simp]: "(null).any = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_at_pre_nullstrict [simp] : "(null).any@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_strict [simp] : "(invalid).any = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩O⇩c⇩l⇩A⇩n⇩y𝒜𝒩𝒴_at_pre_strict [simp] : "(invalid).any@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_nullstrict [simp]: "(null).boss = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre_nullstrict [simp] : "(null).boss@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_strict [simp] : "(invalid).boss = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_at_pre_strict [simp] : "(invalid).boss@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_nullstrict [simp]: "(null).salary = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_nullstrict [simp] : "(null).salary@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_strict [simp] : "(invalid).salary = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
lemma dot⇩P⇩e⇩r⇩s⇩o⇩n𝒮𝒜ℒ𝒜ℛ𝒴_at_pre_strict [simp] : "(invalid).salary@pre = invalid"
by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
subsection‹Representation in States›
lemma dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_def_mono:"τ ⊨ δ(X .boss) ⟹ τ ⊨ δ(X)"
apply(case_tac "τ ⊨ (X ≜ invalid)", insert StrongEq_L_subst2[where P = "(λx. (δ (x .boss)))" and τ = "τ" and x = "X" and y = "invalid"], simp add: foundation16')
apply(case_tac "τ ⊨ (X ≜ null)", insert StrongEq_L_subst2[where P = "(λx. (δ (x .boss)))" and τ = "τ" and x = "X" and y = "null"], simp add: foundation16')
by(simp add: defined_split)
lemma repr_boss:
assumes A : "τ ⊨ δ(x .boss)"
shows "is_represented_in_state in_post_state (x .boss) Person τ"
apply(insert A[simplified foundation16]
A[THEN dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_def_mono, simplified foundation16])
unfolding is_represented_in_state_def
dot⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_def eval_extract_def select⇩P⇩e⇩r⇩s⇩o⇩nℬ𝒪𝒮𝒮_def in_post_state_def
by(auto simp: deref_oid⇩P⇩e⇩r⇩s⇩o⇩n_def bot_fun_def bot_option_def null_option_def null_fun_def invalid_def
OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def image_def ran_def
split: type⇩P⇩e⇩r⇩s⇩o⇩n.split option.split 𝔄.split)
lemma repr_bossX :
assumes A: "τ ⊨ δ(x .boss)"
shows "τ ⊨ ((Person .allInstances()) ->includes⇩S⇩e⇩t(x .boss))"
proof -
have B : "⋀S f. (x .boss) τ ∈ (Some ` f ` S) ⟹
(x .boss) τ ∈ (Some ` (f ` S - {None}))"
apply(auto simp: image_def ran_def, metis)
by(insert A[simplified foundation16], simp add: null_option_def bot_option_def)
show ?thesis
apply(insert repr_boss[OF A] OclAllInstances_at_post_defined[where H = Person and τ = τ])
unfolding is_represented_in_state_def OclValid_def
OclAllInstances_at_post_def OclAllInstances_generic_def OclIncludes_def
in_post_state_def
apply(simp add: A[THEN foundation20, simplified OclValid_def])
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp, metis bot_option_def option.distinct(1))
by(simp add: image_comp B true_def)
qed
section‹A Little Infra-structure on Example States›
text‹
The example we are defining in this section comes from the figure~\ref{fig:edm1_system-states}.
\begin{figure}
\includegraphics[width=\textwidth]{figures/pre-post.pdf}
\caption{(a) pre-state $\sigma_1$ and
(b) post-state $\sigma_1'$.}
\label{fig:edm1_system-states}
\end{figure}
›
text_raw‹\isatagafp›
definition OclInt1000 ("𝟭𝟬𝟬𝟬") where "OclInt1000 = (λ _ . ⌊⌊1000⌋⌋)"
definition OclInt1200 ("𝟭𝟮𝟬𝟬") where "OclInt1200 = (λ _ . ⌊⌊1200⌋⌋)"
definition OclInt1300 ("𝟭𝟯𝟬𝟬") where "OclInt1300 = (λ _ . ⌊⌊1300⌋⌋)"
definition OclInt1800 ("𝟭𝟴𝟬𝟬") where "OclInt1800 = (λ _ . ⌊⌊1800⌋⌋)"
definition OclInt2600 ("𝟮𝟲𝟬𝟬") where "OclInt2600 = (λ _ . ⌊⌊2600⌋⌋)"
definition OclInt2900 ("𝟮𝟵𝟬𝟬") where "OclInt2900 = (λ _ . ⌊⌊2900⌋⌋)"
definition OclInt3200 ("𝟯𝟮𝟬𝟬") where "OclInt3200 = (λ _ . ⌊⌊3200⌋⌋)"
definition OclInt3500 ("𝟯𝟱𝟬𝟬") where "OclInt3500 = (λ _ . ⌊⌊3500⌋⌋)"
definition "oid0 ≡ 0"
definition "oid1 ≡ 1"
definition "oid2 ≡ 2"
definition "oid3 ≡ 3"
definition "oid4 ≡ 4"
definition "oid5 ≡ 5"
definition "oid6 ≡ 6"
definition "oid7 ≡ 7"
definition "oid8 ≡ 8"
definition "person1 ≡ mk⇩P⇩e⇩r⇩s⇩o⇩n oid0 ⌊1300⌋ ⌊oid1⌋"
definition "person2 ≡ mk⇩P⇩e⇩r⇩s⇩o⇩n oid1 ⌊1800⌋ ⌊oid1⌋"
definition "person3 ≡ mk⇩P⇩e⇩r⇩s⇩o⇩n oid2 None None"
definition "person4 ≡ mk⇩P⇩e⇩r⇩s⇩o⇩n oid3 ⌊2900⌋ None"
definition "person5 ≡ mk⇩P⇩e⇩r⇩s⇩o⇩n oid4 ⌊3500⌋ None"
definition "person6 ≡ mk⇩P⇩e⇩r⇩s⇩o⇩n oid5 ⌊2500⌋ ⌊oid6⌋"
definition "person7 ≡ mk⇩O⇩c⇩l⇩A⇩n⇩y oid6 ⌊(⌊3200⌋, ⌊oid6⌋)⌋"
definition "person8 ≡ mk⇩O⇩c⇩l⇩A⇩n⇩y oid7 None"
definition "person9 ≡ mk⇩P⇩e⇩r⇩s⇩o⇩n oid8 ⌊0⌋ None"
definition
"σ⇩1 ≡ ⦇ heap = Map.empty(oid0 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n (mk⇩P⇩e⇩r⇩s⇩o⇩n oid0 ⌊1000⌋ ⌊oid1⌋))
(oid1 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n (mk⇩P⇩e⇩r⇩s⇩o⇩n oid1 ⌊1200⌋ None))
(oid3 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n (mk⇩P⇩e⇩r⇩s⇩o⇩n oid3 ⌊2600⌋ ⌊oid4⌋))
(oid4 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person5)
(oid5 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n (mk⇩P⇩e⇩r⇩s⇩o⇩n oid5 ⌊2300⌋ ⌊oid3⌋))
(oid8 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person9),
assocs = Map.empty ⦈"
definition
"σ⇩1' ≡ ⦇ heap = Map.empty(oid0 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person1)
(oid1 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person2)
(oid2 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person3)
(oid3 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person4)
(oid5 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person6)
(oid6 ↦ in⇩O⇩c⇩l⇩A⇩n⇩y person7)
(oid7 ↦ in⇩O⇩c⇩l⇩A⇩n⇩y person8)
(oid8 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person9),
assocs = Map.empty ⦈"
definition "σ⇩0 ≡ ⦇ heap = Map.empty, assocs = Map.empty ⦈"
lemma basic_τ_wff: "WFF(σ⇩1,σ⇩1')"
by(auto simp: WFF_def σ⇩1_def σ⇩1'_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
oid_of_𝔄_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def oid_of_type⇩O⇩c⇩l⇩A⇩n⇩y_def
person1_def person2_def person3_def person4_def
person5_def person6_def person7_def person8_def person9_def)
lemma [simp,code_unfold]: "dom (heap σ⇩1) = {oid0,oid1,oid3,oid4,oid5,oid8}"
by(auto simp: σ⇩1_def)
lemma [simp,code_unfold]: "dom (heap σ⇩1') = {oid0,oid1,oid2,oid3,oid5,oid6,oid7,oid8}"
by(auto simp: σ⇩1'_def)
text_raw‹\isatagafp›
definition "X⇩P⇩e⇩r⇩s⇩o⇩n1 :: Person ≡ λ _ .⌊⌊ person1 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n2 :: Person ≡ λ _ .⌊⌊ person2 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n3 :: Person ≡ λ _ .⌊⌊ person3 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n4 :: Person ≡ λ _ .⌊⌊ person4 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n5 :: Person ≡ λ _ .⌊⌊ person5 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n6 :: Person ≡ λ _ .⌊⌊ person6 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n7 :: OclAny ≡ λ _ .⌊⌊ person7 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n8 :: OclAny ≡ λ _ .⌊⌊ person8 ⌋⌋"
definition "X⇩P⇩e⇩r⇩s⇩o⇩n9 :: Person ≡ λ _ .⌊⌊ person9 ⌋⌋"
lemma [code_unfold]: "((x::Person) ≐ y) = StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x y" by(simp only: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩P⇩e⇩r⇩s⇩o⇩n)
lemma [code_unfold]: "((x::OclAny) ≐ y) = StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t x y" by(simp only: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_⇩O⇩c⇩l⇩A⇩n⇩y)
lemmas [simp,code_unfold] =
OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_OclAny
OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person
OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_OclAny
OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_Person
OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny
OclIsTypeOf⇩O⇩c⇩l⇩A⇩n⇩y_Person
OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny
OclIsTypeOf⇩P⇩e⇩r⇩s⇩o⇩n_Person
OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_OclAny
OclIsKindOf⇩O⇩c⇩l⇩A⇩n⇩y_Person
OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_OclAny
OclIsKindOf⇩P⇩e⇩r⇩s⇩o⇩n_Person
text_raw‹\endisatagafp›
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .salary <> 𝟭𝟬𝟬𝟬)"
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .salary ≐ 𝟭𝟯𝟬𝟬)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .salary@pre ≐ 𝟭𝟬𝟬𝟬)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .salary@pre <> 𝟭𝟯𝟬𝟬)"
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .boss <> X⇩P⇩e⇩r⇩s⇩o⇩n1)"
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .boss .salary ≐ 𝟭𝟴𝟬𝟬)"
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .boss .boss <> X⇩P⇩e⇩r⇩s⇩o⇩n1)"
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .boss .boss ≐ X⇩P⇩e⇩r⇩s⇩o⇩n2)"
Assert " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .boss@pre .salary ≐ 𝟭𝟴𝟬𝟬)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .boss@pre .salary@pre ≐ 𝟭𝟮𝟬𝟬)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .boss@pre .salary@pre <> 𝟭𝟴𝟬𝟬)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .boss@pre ≐ X⇩P⇩e⇩r⇩s⇩o⇩n2)"
Assert " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .boss@pre .boss ≐ X⇩P⇩e⇩r⇩s⇩o⇩n2)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .boss@pre .boss@pre ≐ null)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n1 .boss@pre .boss@pre .boss@pre))"
lemma " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def
σ⇩1_def σ⇩1'_def
X⇩P⇩e⇩r⇩s⇩o⇩n1_def person1_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def)
lemma "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ ((X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclAsType(OclAny) .oclAsType(Person)) ≐ X⇩P⇩e⇩r⇩s⇩o⇩n1)"
by(rule up_down_cast_Person_OclAny_Person', simp add: X⇩P⇩e⇩r⇩s⇩o⇩n1_def)
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclIsTypeOf(Person))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ not(X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclIsTypeOf(OclAny))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclIsKindOf(Person))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclIsKindOf(OclAny))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ not(X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclAsType(OclAny) .oclIsTypeOf(OclAny))"
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n2 .salary ≐ 𝟭𝟴𝟬𝟬)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n2 .salary@pre ≐ 𝟭𝟮𝟬𝟬)"
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n2 .boss ≐ X⇩P⇩e⇩r⇩s⇩o⇩n2)"
Assert " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n2 .boss .salary@pre ≐ 𝟭𝟮𝟬𝟬)"
Assert " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n2 .boss .boss@pre ≐ null)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n2 .boss@pre ≐ null)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n2 .boss@pre <> X⇩P⇩e⇩r⇩s⇩o⇩n2)"
Assert " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n2 .boss@pre <> (X⇩P⇩e⇩r⇩s⇩o⇩n2 .boss))"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n2 .boss@pre .boss))"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n2 .boss@pre .salary@pre))"
lemma " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n2 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def σ⇩1_def σ⇩1'_def X⇩P⇩e⇩r⇩s⇩o⇩n2_def person2_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def)
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n3 .salary ≐ null)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n3 .salary@pre))"
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n3 .boss ≐ null)"
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n3 .boss .salary))"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n3 .boss@pre))"
lemma " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n3 .oclIsNew())"
by(simp add: OclValid_def OclIsNew_def σ⇩1_def σ⇩1'_def X⇩P⇩e⇩r⇩s⇩o⇩n3_def person3_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def
oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def)
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n4 .boss@pre ≐ X⇩P⇩e⇩r⇩s⇩o⇩n5)"
Assert " (σ⇩1,σ⇩1') ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n4 .boss@pre .salary))"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n4 .boss@pre .salary@pre ≐ 𝟯𝟱𝟬𝟬)"
lemma " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n4 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def σ⇩1_def σ⇩1'_def X⇩P⇩e⇩r⇩s⇩o⇩n4_def person4_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def)
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n5 .salary))"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n5 .salary@pre ≐ 𝟯𝟱𝟬𝟬)"
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n5 .boss))"
lemma " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n5 .oclIsDeleted())"
by(simp add: OclNot_def OclValid_def OclIsDeleted_def σ⇩1_def σ⇩1'_def X⇩P⇩e⇩r⇩s⇩o⇩n5_def person5_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def)
Assert "⋀s⇩p⇩r⇩e . (s⇩p⇩r⇩e,σ⇩1') ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n6 .boss .salary@pre))"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n6 .boss@pre ≐ X⇩P⇩e⇩r⇩s⇩o⇩n4)"
Assert " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n6 .boss@pre .salary ≐ 𝟮𝟵𝟬𝟬)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n6 .boss@pre .salary@pre ≐ 𝟮𝟲𝟬𝟬)"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n6 .boss@pre .boss@pre ≐ X⇩P⇩e⇩r⇩s⇩o⇩n5)"
lemma " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n6 .oclIsMaintained())"
by(simp add: OclValid_def OclIsMaintained_def σ⇩1_def σ⇩1'_def X⇩P⇩e⇩r⇩s⇩o⇩n6_def person6_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def)
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ υ(X⇩P⇩e⇩r⇩s⇩o⇩n7 .oclAsType(Person))"
Assert "⋀ s⇩p⇩o⇩s⇩t. (σ⇩1,s⇩p⇩o⇩s⇩t) ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n7 .oclAsType(Person) .boss@pre))"
lemma "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ ((X⇩P⇩e⇩r⇩s⇩o⇩n7 .oclAsType(Person) .oclAsType(OclAny)
.oclAsType(Person))
≐ (X⇩P⇩e⇩r⇩s⇩o⇩n7 .oclAsType(Person)))"
by(rule up_down_cast_Person_OclAny_Person', simp add: X⇩P⇩e⇩r⇩s⇩o⇩n7_def OclValid_def valid_def person7_def)
lemma " (σ⇩1,σ⇩1') ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n7 .oclIsNew())"
by(simp add: OclValid_def OclIsNew_def σ⇩1_def σ⇩1'_def X⇩P⇩e⇩r⇩s⇩o⇩n7_def person7_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def
oid_of_option_def oid_of_type⇩O⇩c⇩l⇩A⇩n⇩y_def)
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n8 <> X⇩P⇩e⇩r⇩s⇩o⇩n7)"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ not(υ(X⇩P⇩e⇩r⇩s⇩o⇩n8 .oclAsType(Person)))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n8 .oclIsTypeOf(OclAny))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ not(X⇩P⇩e⇩r⇩s⇩o⇩n8 .oclIsTypeOf(Person))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ not(X⇩P⇩e⇩r⇩s⇩o⇩n8 .oclIsKindOf(Person))"
Assert "⋀s⇩p⇩r⇩e s⇩p⇩o⇩s⇩t. (s⇩p⇩r⇩e,s⇩p⇩o⇩s⇩t) ⊨ (X⇩P⇩e⇩r⇩s⇩o⇩n8 .oclIsKindOf(OclAny))"
lemma σ_modifiedonly: "(σ⇩1,σ⇩1') ⊨ (Set{ X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclAsType(OclAny)
, X⇩P⇩e⇩r⇩s⇩o⇩n2 .oclAsType(OclAny)
, X⇩P⇩e⇩r⇩s⇩o⇩n4 .oclAsType(OclAny)
, X⇩P⇩e⇩r⇩s⇩o⇩n6 .oclAsType(OclAny)
}->oclIsModifiedOnly())"
apply(simp add: OclIsModifiedOnly_def OclValid_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
X⇩P⇩e⇩r⇩s⇩o⇩n1_def X⇩P⇩e⇩r⇩s⇩o⇩n2_def X⇩P⇩e⇩r⇩s⇩o⇩n3_def X⇩P⇩e⇩r⇩s⇩o⇩n4_def
X⇩P⇩e⇩r⇩s⇩o⇩n5_def X⇩P⇩e⇩r⇩s⇩o⇩n6_def X⇩P⇩e⇩r⇩s⇩o⇩n7_def X⇩P⇩e⇩r⇩s⇩o⇩n8_def X⇩P⇩e⇩r⇩s⇩o⇩n9_def
person1_def person2_def person3_def person4_def
person5_def person6_def person7_def person8_def person9_def
image_def)
apply(simp add: OclIncluding_rep_set mtSet_rep_set null_option_def bot_option_def)
apply(simp add: oid_of_option_def oid_of_type⇩O⇩c⇩l⇩A⇩n⇩y_def, clarsimp)
apply(simp add: σ⇩1_def σ⇩1'_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
done
lemma "(σ⇩1,σ⇩1') ⊨ ((X⇩P⇩e⇩r⇩s⇩o⇩n9 @pre (λx. ⌊OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄 x⌋)) ≜ X⇩P⇩e⇩r⇩s⇩o⇩n9)"
by(simp add: OclSelf_at_pre_def σ⇩1_def oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def
X⇩P⇩e⇩r⇩s⇩o⇩n9_def person9_def oid8_def OclValid_def StrongEq_def OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def)
lemma "(σ⇩1,σ⇩1') ⊨ ((X⇩P⇩e⇩r⇩s⇩o⇩n9 @post (λx. ⌊OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄 x⌋)) ≜ X⇩P⇩e⇩r⇩s⇩o⇩n9)"
by(simp add: OclSelf_at_post_def σ⇩1'_def oid_of_option_def oid_of_type⇩P⇩e⇩r⇩s⇩o⇩n_def
X⇩P⇩e⇩r⇩s⇩o⇩n9_def person9_def oid8_def OclValid_def StrongEq_def OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def)
lemma "(σ⇩1,σ⇩1') ⊨ (((X⇩P⇩e⇩r⇩s⇩o⇩n9 .oclAsType(OclAny)) @pre (λx. ⌊OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄 x⌋)) ≜
((X⇩P⇩e⇩r⇩s⇩o⇩n9 .oclAsType(OclAny)) @post (λx. ⌊OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄 x⌋)))"
proof -
have including4 : "⋀a b c d τ.
Set{λτ. ⌊⌊a⌋⌋, λτ. ⌊⌊b⌋⌋, λτ. ⌊⌊c⌋⌋, λτ. ⌊⌊d⌋⌋} τ = Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ {⌊⌊a⌋⌋, ⌊⌊b⌋⌋, ⌊⌊c⌋⌋, ⌊⌊d⌋⌋} ⌋⌋"
apply(subst abs_rep_simp'[symmetric], simp)
apply(simp add: OclIncluding_rep_set mtSet_rep_set)
by(rule arg_cong[of _ _ "λx. (Abs_Set⇩b⇩a⇩s⇩e(⌊⌊ x ⌋⌋))"], auto)
have excluding1: "⋀S a b c d e τ.
(λ_. Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ {⌊⌊a⌋⌋, ⌊⌊b⌋⌋, ⌊⌊c⌋⌋, ⌊⌊d⌋⌋} ⌋⌋)->excluding⇩S⇩e⇩t(λτ. ⌊⌊e⌋⌋) τ =
Abs_Set⇩b⇩a⇩s⇩e ⌊⌊ {⌊⌊a⌋⌋, ⌊⌊b⌋⌋, ⌊⌊c⌋⌋, ⌊⌊d⌋⌋} - {⌊⌊e⌋⌋} ⌋⌋"
apply(simp add: UML_Set.OclExcluding_def)
apply(simp add: defined_def OclValid_def false_def true_def
bot_fun_def bot_Set⇩b⇩a⇩s⇩e_def null_fun_def null_Set⇩b⇩a⇩s⇩e_def)
apply(rule conjI)
apply(rule impI, subst (asm) Abs_Set⇩b⇩a⇩s⇩e_inject) apply( simp add: bot_option_def)+
apply(rule conjI)
apply(rule impI, subst (asm) Abs_Set⇩b⇩a⇩s⇩e_inject) apply( simp add: bot_option_def null_option_def)+
apply(subst Abs_Set⇩b⇩a⇩s⇩e_inverse, simp add: bot_option_def, simp)
done
show ?thesis
apply(rule framing[where X = "Set{ X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclAsType(OclAny)
, X⇩P⇩e⇩r⇩s⇩o⇩n2 .oclAsType(OclAny)
, X⇩P⇩e⇩r⇩s⇩o⇩n4 .oclAsType(OclAny)
, X⇩P⇩e⇩r⇩s⇩o⇩n6 .oclAsType(OclAny)
}"])
apply(cut_tac σ_modifiedonly)
apply(simp only: OclValid_def
X⇩P⇩e⇩r⇩s⇩o⇩n1_def X⇩P⇩e⇩r⇩s⇩o⇩n2_def X⇩P⇩e⇩r⇩s⇩o⇩n3_def X⇩P⇩e⇩r⇩s⇩o⇩n4_def
X⇩P⇩e⇩r⇩s⇩o⇩n5_def X⇩P⇩e⇩r⇩s⇩o⇩n6_def X⇩P⇩e⇩r⇩s⇩o⇩n7_def X⇩P⇩e⇩r⇩s⇩o⇩n8_def X⇩P⇩e⇩r⇩s⇩o⇩n9_def
person1_def person2_def person3_def person4_def
person5_def person6_def person7_def person8_def person9_def
OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_Person)
apply(subst cp_OclIsModifiedOnly, subst UML_Set.OclExcluding.cp0,
subst (asm) cp_OclIsModifiedOnly, simp add: including4 excluding1)
apply(simp only: X⇩P⇩e⇩r⇩s⇩o⇩n1_def X⇩P⇩e⇩r⇩s⇩o⇩n2_def X⇩P⇩e⇩r⇩s⇩o⇩n3_def X⇩P⇩e⇩r⇩s⇩o⇩n4_def
X⇩P⇩e⇩r⇩s⇩o⇩n5_def X⇩P⇩e⇩r⇩s⇩o⇩n6_def X⇩P⇩e⇩r⇩s⇩o⇩n7_def X⇩P⇩e⇩r⇩s⇩o⇩n8_def X⇩P⇩e⇩r⇩s⇩o⇩n9_def
person1_def person2_def person3_def person4_def
person5_def person6_def person7_def person8_def person9_def)
apply(simp add: OclIncluding_rep_set mtSet_rep_set
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
apply(simp add: StrictRefEq⇩O⇩b⇩j⇩e⇩c⇩t_def oid_of_option_def oid_of_type⇩O⇩c⇩l⇩A⇩n⇩y_def OclNot_def OclValid_def
null_option_def bot_option_def)
done
qed
lemma perm_σ⇩1' : "σ⇩1' = ⦇ heap = Map.empty
(oid8 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person9)
(oid7 ↦ in⇩O⇩c⇩l⇩A⇩n⇩y person8)
(oid6 ↦ in⇩O⇩c⇩l⇩A⇩n⇩y person7)
(oid5 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person6)
(oid3 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person4)
(oid2 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person3)
(oid1 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person2)
(oid0 ↦ in⇩P⇩e⇩r⇩s⇩o⇩n person1)
, assocs = assocs σ⇩1' ⦈"
proof -
note P = fun_upd_twist
show ?thesis
apply(simp add: σ⇩1'_def
oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
apply(subst (1) P, simp)
apply(subst (2) P, simp) apply(subst (1) P, simp)
apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
apply(subst (7) P, simp) apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
by(simp)
qed
declare const_ss [simp]
lemma "⋀σ⇩1.
(σ⇩1,σ⇩1') ⊨ (Person .allInstances() ≐ Set{ X⇩P⇩e⇩r⇩s⇩o⇩n1, X⇩P⇩e⇩r⇩s⇩o⇩n2, X⇩P⇩e⇩r⇩s⇩o⇩n3, X⇩P⇩e⇩r⇩s⇩o⇩n4, X⇩P⇩e⇩r⇩s⇩o⇩n6,
X⇩P⇩e⇩r⇩s⇩o⇩n7 .oclAsType(Person), X⇩P⇩e⇩r⇩s⇩o⇩n9 })"
apply(subst perm_σ⇩1')
apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
X⇩P⇩e⇩r⇩s⇩o⇩n1_def X⇩P⇩e⇩r⇩s⇩o⇩n2_def X⇩P⇩e⇩r⇩s⇩o⇩n3_def X⇩P⇩e⇩r⇩s⇩o⇩n4_def
X⇩P⇩e⇩r⇩s⇩o⇩n5_def X⇩P⇩e⇩r⇩s⇩o⇩n6_def X⇩P⇩e⇩r⇩s⇩o⇩n7_def X⇩P⇩e⇩r⇩s⇩o⇩n8_def X⇩P⇩e⇩r⇩s⇩o⇩n9_def
person7_def)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
apply(subst state_update_vs_allInstances_at_post_ntc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def
person8_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
apply(rule state_update_vs_allInstances_at_post_empty)
by(simp_all add: OclAsType⇩P⇩e⇩r⇩s⇩o⇩n_𝔄_def)
lemma "⋀σ⇩1.
(σ⇩1,σ⇩1') ⊨ (OclAny .allInstances() ≐ Set{ X⇩P⇩e⇩r⇩s⇩o⇩n1 .oclAsType(OclAny), X⇩P⇩e⇩r⇩s⇩o⇩n2 .oclAsType(OclAny),
X⇩P⇩e⇩r⇩s⇩o⇩n3 .oclAsType(OclAny), X⇩P⇩e⇩r⇩s⇩o⇩n4 .oclAsType(OclAny)
, X⇩P⇩e⇩r⇩s⇩o⇩n6 .oclAsType(OclAny),
X⇩P⇩e⇩r⇩s⇩o⇩n7, X⇩P⇩e⇩r⇩s⇩o⇩n8, X⇩P⇩e⇩r⇩s⇩o⇩n9 .oclAsType(OclAny) })"
apply(subst perm_σ⇩1')
apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
X⇩P⇩e⇩r⇩s⇩o⇩n1_def X⇩P⇩e⇩r⇩s⇩o⇩n2_def X⇩P⇩e⇩r⇩s⇩o⇩n3_def X⇩P⇩e⇩r⇩s⇩o⇩n4_def X⇩P⇩e⇩r⇩s⇩o⇩n5_def X⇩P⇩e⇩r⇩s⇩o⇩n6_def X⇩P⇩e⇩r⇩s⇩o⇩n7_def X⇩P⇩e⇩r⇩s⇩o⇩n8_def X⇩P⇩e⇩r⇩s⇩o⇩n9_def
person1_def person2_def person3_def person4_def person5_def person6_def person9_def)
apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄_def, simp, rule const_StrictRefEq⇩S⇩e⇩t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)+
apply(rule state_update_vs_allInstances_at_post_empty)
by(simp_all add: OclAsType⇩O⇩c⇩l⇩A⇩n⇩y_𝔄_def)
end
Theory Design_OCL
theory
Design_OCL
imports
Design_UML
begin
text ‹\label{ex:employee-design:ocl}›
section‹OCL Part: Invariant›
text‹These recursive predicates can be defined conservatively
by greatest fix-point
constructions---automatically. See~\cite{brucker.ea:hol-ocl-book:2006,brucker:interactive:2007}
for details. For the purpose of this example, we state them as axioms
here.
\begin{ocl}
context Person
inv label : self .boss <> null implies (self .salary ≤ ((self .boss) .salary))
\end{ocl}
›
definition Person_label⇩i⇩n⇩v :: "Person ⇒ Boolean"
where "Person_label⇩i⇩n⇩v (self) ≡
(self .boss <> null implies (self .salary ≤⇩i⇩n⇩t ((self .boss) .salary)))"
definition Person_label⇩i⇩n⇩v⇩A⇩T⇩p⇩r⇩e :: "Person ⇒ Boolean"
where "Person_label⇩i⇩n⇩v⇩A⇩T⇩p⇩r⇩e (self) ≡
(self .boss@pre <> null implies (self .salary@pre ≤⇩i⇩n⇩t ((self .boss@pre) .salary@pre)))"
definition Person_label⇩g⇩l⇩o⇩b⇩a⇩l⇩i⇩n⇩v :: "Boolean"
where "Person_label⇩g⇩l⇩o⇩b⇩a⇩l⇩i⇩n⇩v ≡ (Person .allInstances()->forAll⇩S⇩e⇩t(x | Person_label⇩i⇩n⇩v (x)) and
(Person .allInstances@pre()->forAll⇩S⇩e⇩t(x | Person_label⇩i⇩n⇩v⇩A⇩T⇩p⇩r⇩e (x))))"
lemma "τ ⊨ δ (X .boss) ⟹ τ ⊨ Person .allInstances()->includes⇩S⇩e⇩t(X .boss) ∧
τ ⊨ Person .allInstances()->includes⇩S⇩e⇩t(X) "
oops
lemma REC_pre : "τ ⊨ Person_label⇩g⇩l⇩o⇩b⇩a⇩l⇩i⇩n⇩v
⟹ τ ⊨ Person .allInstances()->includes⇩S⇩e⇩t(X)
⟹ ∃ REC. τ ⊨ REC(X) ≜ (Person_label⇩i⇩n⇩v (X) and (X .boss <> null implies REC(X .boss)))"
oops
text‹This allows to state a predicate:›
axiomatization inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l :: "Person ⇒ Boolean"
where inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l_def:
"(τ ⊨ Person .allInstances()->includes⇩S⇩e⇩t(self)) ⟹
(τ ⊨ (inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l(self) ≜ (self .boss <> null implies
(self .salary ≤⇩i⇩n⇩t ((self .boss) .salary)) and
inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l(self .boss))))"
axiomatization inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l⇩A⇩T⇩p⇩r⇩e :: "Person ⇒ Boolean"
where inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l⇩A⇩T⇩p⇩r⇩e_def:
"(τ ⊨ Person .allInstances@pre()->includes⇩S⇩e⇩t(self)) ⟹
(τ ⊨ (inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l⇩A⇩T⇩p⇩r⇩e(self) ≜ (self .boss@pre <> null implies
(self .salary@pre ≤⇩i⇩n⇩t ((self .boss@pre) .salary@pre)) and
inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l⇩A⇩T⇩p⇩r⇩e(self .boss@pre))))"
lemma inv_1 :
"(τ ⊨ Person .allInstances()->includes⇩S⇩e⇩t(self)) ⟹
(τ ⊨ inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l(self) = ((τ ⊨ (self .boss ≐ null)) ∨
( τ ⊨ (self .boss <> null) ∧
τ ⊨ ((self .salary) ≤⇩i⇩n⇩t (self .boss .salary)) ∧
τ ⊨ (inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l(self .boss))))) "
oops
lemma inv_2 :
"(τ ⊨ Person .allInstances@pre()->includes⇩S⇩e⇩t(self)) ⟹
(τ ⊨ inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l⇩A⇩T⇩p⇩r⇩e(self)) = ((τ ⊨ (self .boss@pre ≐ null)) ∨
(τ ⊨ (self .boss@pre <> null) ∧
(τ ⊨ (self .boss@pre .salary@pre ≤⇩i⇩n⇩t self .salary@pre)) ∧
(τ ⊨ (inv⇩P⇩e⇩r⇩s⇩o⇩n⇩_⇩l⇩a⇩b⇩e⇩l⇩A⇩T⇩p⇩r⇩e(self .boss@pre)))))"
oops
text‹A very first attempt to characterize the axiomatization by an inductive
definition - this can not be the last word since too weak (should be equality!)›
coinductive inv :: "Person ⇒ (𝔄)st ⇒ bool" where
"(τ ⊨ (δ self)) ⟹ ((τ ⊨ (self .boss ≐ null)) ∨
(τ ⊨ (self .boss <> null) ∧ (τ ⊨ (self .boss .salary ≤⇩i⇩n⇩t self .salary)) ∧
( (inv(self .boss))τ )))
⟹ ( inv self τ)"
section‹OCL Part: The Contract of a Recursive Query›
text‹This part is analogous to the Analysis Model and skipped here.›
end